Skip to content
Snippets Groups Projects
Commit 2b6046c9 authored by Dethinne Thomas's avatar Dethinne Thomas
Browse files

debug so the output in netcdf compile

parent e5056921
No related branches found
No related tags found
No related merge requests found
common /var2d/ area_burn_2d(mx,my), aetmth_2d(mx,my),
& albmth_2d(mx,my),albsmth_2d(mx,my), albsvmth_2d(mx,my),
& albvmth_2d(mx,my), ybiombg_2d(mx,my,npft), xdbiom_2d(mx,my),
& ysoilr_2d(mx,my,5), ybiomf_2d(mx,my,npft), drnmth_2d(mx,my)
& ybiomag_2d(mx,my,npft), eminsmth_2d(mx,my), esomth_2d(mx,my),
& emi_burn_lit_2d(mx,my), xemifire_2d(npft,iday), xdemifire_2d(mx,my),
& albvmth_2d(mx,my), ybiombg_2d(mx,my,26), xdbiom_2d(mx,my),
& ysoilr_2d(mx,my,5), ybiomf_2d(mx,my,26), drnmth_2d(mx,my),
& ybiomag_2d(mx,my,26),
& emi_burn_lit_2d(mx,my), xemifire_2d(mx,my,26),
& xdemifire_2d(mx,my), eintmth_2d(mx,my),
& emimth_2d(mx,my), eminsmth_2d(mx,my), esomth_2d(mx,my),
& etrmth_2d(mx,my), xmfapar_2d(mx,my), frac_burn_2d(mx,my),
& Fgdd5_2d(mx,my,npft), fgsmth_2d(mx,my), firdmth_2d(mx,my),
& frac_2d(mx,my,npft), frc_2d(mx,my,npft), yfractf_2d(mx,my,npft),
& fsnmth_2d(mx,my), solmth_2d(mx,my), FTmmin_2d(mx,my,npft),
& ftmin_2d(mx,my,npft), ftot_2d(mx,my,npft), fwat_2d(mx,my,npft),
& Fwatmin_2d(mx,my,npft), xgpp_2d(mx,my), xdgpp_2d(mx,my),
& grfmth_2d(mx,my), ycharvest_2d(mx,my,npft), xdcharvest_2d(mx,my),
& tlamth_2d(mx,my), xlai(mx,my,npft), xmlai_2d(mx,my),
& z0mth_2d(mx,my), maturity_2d(mx,my,npft), xdnbp_2d(mx,my),
& xdnep_2d(mx,my), xnpp_2d(mx,my,npft), xdnpp_2d(mx,my),
& petmth_2d(mx,my), Pf_2d(mx,my), xdra_2d(mx,my), xra_2d(mx,my,npft),
& rblmth_2d(mx,my), xdrh_2d(mx,my), R_min_2d(mx,my,npft),
& Fgdd5_2d(mx,my,26), fgsmth_2d(mx,my), firdmth_2d(mx,my),
& frac_2d(mx,my,26), frc_2d(mx,my,26), yfractf_2d(mx,my,26),
& fsnmth_2d(mx,my), solmth_2d(mx,my), FTmmin_2d(mx,my,26),
& ftmin_2d(mx,my,26), ftot_2d(mx,my,26), fwat_2d(mx,my,26),
& Fwatmin_2d(mx,my,26), xgpp_2d(mx,my,26), xdgpp_2d(mx,my),
& grfmth_2d(mx,my), ycharvest_2d(mx,my,26), xdcharvest_2d(mx,my),
& tlamth_2d(mx,my), xlai_2d(mx,my,26), xmlai_2d(mx,my),
& maturity_2d(mx,my,26), xdnbp_2d(mx,my),
& xdnep_2d(mx,my), xnpp_2d(mx,my,26), xdnpp_2d(mx,my),
& petmth_2d(mx,my), Pf_2d(mx,my), xdra_2d(mx,my),
& xra_2d(mx,my,26),
& rblmth_2d(mx,my), xdrh_2d(mx,my), R_min_2d(mx,my,26),
& rnmth_2d(mx,my), rtrmth_2d(mx,my), runmth_2d(mx,my),
& sfmth_2d(mx,my), smlmth_2d(mx,my), sndmth_2d(mx,my),
& snemth_2d(mx,my), srunmth_2d(mx,my), svemth_2d(mx,my),
& swmth_2d(mx,my), swmmmth_2d(mx,my), tsmth_2d(mx,my),
& xlai_min_2d(mx,my,npft), xlai_max_2d(mx,my,npft), xhmth_2d(mx,my),
& xlemth_2d(mx,my), fnat_2d(mx,my,npft), yield_2d(mx,my,npft),
& xlai_min_2d(mx,my,26), xlai_max_2d(mx,my,26),
& xhmth_2d(mx,my),
& xlemth_2d(mx,my), fnat_2d(mx,my,26), yield_2d(mx,my,26),
& z0mth_2d(mx,my),
& fsi_2d(mx,my), fci_2d(mx,my), wpi_2d(mx,my), rootd_2d(mx,my),
& prcy_2d(mx,my), runy_2d(mx,my), svey_2d(mx,my), eiry_2d(mx,my),
......@@ -32,8 +35,8 @@
real area_burn_2d, aetmth_2d,
& albmth_2d, albsmth_2d, albsvmth_2d,
& albvmth_2d, ybiombg_2d, xdbiom_2d,
& ysoilr_2d, ybiomf_2d, drnmth_2d
& ybiomag_2d, eminsmth_2d, esomth_2d,
& ysoilr_2d, ybiomf_2d, drnmth_2d,
& ybiomag_2d, eintmth_2d,
& emi_burn_lit_2d, xemifire_2d, xdemifire_2d,
& emimth_2d, eminsmth_2d, esomth_2d,
& etrmth_2d, xmfapar_2d, frac_burn_2d,
......@@ -43,8 +46,8 @@
& ftmin_2d, ftot_2d, fwat_2d,
& Fwatmin_2d, xgpp_2d, xdgpp_2d,
& grfmth_2d, ycharvest_2d, xdcharvest_2d,
& tlamth_2d, xlai, xmlai_2d,
& z0mth_2d, maturity_2d, xdnbp_2d,
& tlamth_2d, xlai_2d, xmlai_2d,
& maturity_2d, xdnbp_2d,
& xdnep_2d, xnpp_2d, xdnpp_2d,
& petmth_2d, Pf_2d, xdra_2d, xra_2d,
& rblmth_2d, xdrh_2d, R_min_2d,
......
subroutine fill_table(pixel_number)
USE MOD_NETCDFCARAIB
use marctr
use mar_ge
use marphy
......@@ -8,19 +7,17 @@
IMPLICIT NONE
include './com_18/cstpi.common'
include './com_18/parameter.common'
include './com_18/eco.common'
include './com_18/files_ibm.common'
include './com_18/flux_w.common'
include './com_18/monthcst.common'
include './com_18/monwat.common'
include './com_18/prt.common'
include './com_18/smrd.common'
include './com_18/varnow.common'
include './com_18/vegfr.common'
include './com_18/waflux.common'
include './com_18/parameter.common'
include './com_18/abobio.common'
include './com_18/angppf.common'
include './com_18/annee.common'
......@@ -28,7 +25,7 @@
include './com_18/biomasse.common'
include './com_18/burned.common'
include './com_18/cmoiRmin.common'
include './com_18/coord.common'
! include './com_18/coord.common'
include './com_18/crops.common'
include './com_18/cte.common'
include './com_18/dayres.common'
......@@ -52,8 +49,12 @@
include './com_18/pzone.common'
include './com_18/soil_pool.common'
include './com_18/xvalues.common'
! include './com_18/monthcst.common'
include './com_18/var2d.common'
integer pixel_number, i, j
integer pixel_number, i, j, daynbr
real eiry, wbudy
daynbr=njyrGE(mmarGE)+njybGE(mmarGE)*max(0,1-mod(iyrrGE,4))+jdarGE
......@@ -83,7 +84,7 @@
esomth_2d(i,j) = esomth(daynbr)
etrmth_2d(i,j) = etrmth(daynbr)
xmfapar_2d(i,j) = xmfapar(m)
xmfapar_2d(i,j) = xmfapar(mmarGE)
frac_burn_2d(i,j) = frac_burn(daynbr)
fgsmth_2d(i,j) = fgsmth(daynbr)
......@@ -96,9 +97,9 @@
xdcharvest_2d(i,j) = xdcharvest(daynbr)
tlamth_2d(i,j) = tlamth(daynbr)
xmlai_2d(i,j) = xmlai(m)
xmlai_2d(i,j) = xmlai(mmarGE)
z0mth_2d(i,j) = z0mth(daynbr)
!z0mth_2d(i,j) = z0mth(daynbr)
xdnbp_2d(i,j) = xdnbp(daynbr)
xdnep_2d(i,j) = xdnep(daynbr)
xdnpp_2d(i,j) = xdnpp(daynbr)
......@@ -124,6 +125,9 @@
z0mth_2d(i,j) = z0mth(daynbr)
!Water budget
eiry=soey-svey
wbudy = prcy-runy-soey-sney
fsi_2d(i,j) = fsi
fci_2d(i,j) = fci
wpi_2d(i,j) = wpi
......@@ -159,13 +163,13 @@
xlai_min_2d(i,j,ip) = xlai_min(ip)
xlai_max_2d(i,j,ip) = xlai_max(ip)
fnat_2d(i,j,ip) = fnat(ip)
yield_2d(i,j) = yield(ip)
yield_2d(i,j,ip) = yield(ip)
!daily
xemifire_2d(i,j,ip) = xemifire(ip,iday)
xgpp(i,j,ip) = xgpp(ip,iday)
xlai(i,j,ip) = xlai(ip,iday)
xnpp(i,j,ip) = xnpp(ip,iday)
xgpp_2d(i,j,ip) = xgpp(ip,iday)
xlai_2d(i,j,ip) = xlai(ip,iday)
xnpp_2d(i,j,ip) = xnpp(ip,iday)
xra_2d(i,j,ip) = xra(ip,daynbr)
enddo
......@@ -175,7 +179,7 @@
!The amount of carbon is stock at different places (cf user guide)
ysoilr_2d(i,j,0) = ysoilr(0)
ysoilr_2d(i,j,1) = ylitr
ysoilr_2d(i,j,1) = ysoilr(1)+ysoilr(2)
ysoilr_2d(i,j,2) = ysoilr(1)
ysoilr_2d(i,j,3) = ysoilr(2)
ysoilr_2d(i,j,4) = ysoilr(3)
......
subroutine write_res
USE MOD_NETCDFCARAIB
! USE MOD_NETCDFCARAIB
use marctr
use mar_ge
use marphy
use margrd
use mar_io
use mar_ib
IMPLICIT NONE
INCLUDE 'NetCDF.inc'
include './com_18/var2d.common'
integer, i,j,k,l,m
character * 120 tmpINP
integer i,j,k,l,m,iostat
integer Lfnam, Ltit, Luni, Lnam, Llnam
PARAMETER(Lfnam=40, Ltit=90, Luni=90, Lnam=13, Llnam=50)
......@@ -30,27 +35,36 @@
PARAMETER(MX_var=200)
! +...Maximum Number of Variables
integer NattNC_ice
PARAMETER(NattNC_ice=1)
integer NattNC_CAR
PARAMETER(NattNC_CAR=1)
! +...Number of real attributes given to all variables
integer PFT, KPOOL
PARAMETER(PFT=npft, KPOOL=5)
PARAMETER(PFT=26, KPOOL=5)
real VALdim(MXdim, 0:NdimNC)
real VALdim(MXdim, 0:NdimNC_CAR)
integer NvatNC_CAR(NattNC_CAR)
character * (Lnam) nameNC_CAR(MX_var)
character * (Luni) UNIdim(0:NdimNC_ice)
character * (Luni) UNIdim(0:NdimNC_CAR)
character * (Lnam) NAMdim(0:NdimNC_CAR)
integer i,j, nbr_pixel, n1000,n100a,n100,n10_a,n10,n1
integer m10,m1,jd10,jd1, date
character * (Lnam) SdimNC_CAR(4, MX_var)
character * (Luni) unitNC_CAR(MX_var)
character * (Llnam) lnamNC_CAR(MX_var)
character * (Ltit) tit_NC_CAR
character * (Lnam) NAMrat(NattNC_CAR)
integer nbr_pixel, n1000,n100a,n100,n10_a,n10,n1, ID__nc_CAR
integer m10,jd10,jd1, date, OutdyIB0, itotNC_CAR,NtotNC_CAR
character * (Lfnam) fnamNC_CAR
real mar_lon(mx,my),mar_lat(mx,my),
& isuy(mx,my),av_cla(mx,j),av_sil(mx,j)
& av_san(mx,j),sh(mx,j)
& av_col(mx,j),f_l(mx,j)
& isuy(mx,my),av_cla(mx,my),av_sil(mx,my),
& av_san(mx,my),topo(mx,my),
& av_col(mx,my),f_l(mx,my)
......@@ -73,13 +87,13 @@
fnamNC_CAR = 'CAR.' &
//labnum(n1000)//labnum(n100) &
//labnum(n10)//labnum(n1) &
//labnum(m10)//labnum(m1) &
//labnum(jd10)//labnum(jd1) &
//'.'//explIO &
//'.nc '
fnamNC_CAR = 'CAR.'
& //labnum(n1000)//labnum(n100)
& //labnum(n10)//labnum(n1)
& //labnum(m10)//labnum(m1)
& //labnum(jd10)//labnum(jd1)
& //'.'//explIO
& //'.nc '
n1000 = 1 + iyr0GE / 1000
n100a = mod(iyr0GE, 1000)
......@@ -95,11 +109,11 @@
! set dim 1 = TIME
nDFdim(0) = 1
NAMdim(0) = 'time'
UNIdim(0) = 'DAYS since ' &
//labnum(n1000)//labnum(n100) &
//labnum(n10)//labnum(n1)//'-' &
//labnum(m10)//labnum(m1)//'-' &
//labnum(jd10)//labnum(jd1)//' 00:00:00'
UNIdim(0) = 'DAYS since '
& //labnum(n1000)//labnum(n100)
& //labnum(n10)//labnum(n1)//'-'
& //labnum(m10)//labnum(m1)//'-'
& //labnum(jd10)//labnum(jd1)//' 00:00:00'
if(OutdyIB == 1) date = nint(real(itexpe) * dt / (3600.*24.))
......@@ -127,7 +141,7 @@
nDFdim(3) = PFT
NAMdim(3) = 'PFT'
UNIdim(3) = 'plant funct type'
do l = 1, FPT
do l = 1, PFT
VALdim(l, 3) = l
enddo
......@@ -138,60 +152,66 @@
do m = 1, KPOOL
VALdim(m,4) = m
enddo
itotNC_CAR = 0
! get all name and units
OPEN(unit=10, status='unknown', file='CARvou.dat')
980 continue
980 continue
READ(10, '(A120)', end=990) tmpINP
if(tmpINP(1:4) == ' ') then
itotNC_CAR = itotNC_CAR + 1
READ(tmpINP, '(4x,5A9,A12,A50)') &
nameNC_ice(itotNC_CAR), &
SdimNC_CAR(1, itotNC_CAR), &
SdimNC_CAR(2, itotNC_CAR), &
SdimNC_CAR(3, itotNC_CAR), &
SdimNC_CAR(4, itotNC_CAR), &
unitNC_CAR(itotNC_CAR), &
lnamNC_CAR(itotNC_CAR)
READ(tmpINP, '(4x,5A9,A12,A50)')
& nameNC_CAR(itotNC_CAR),
& SdimNC_CAR(1, itotNC_CAR),
& SdimNC_CAR(2, itotNC_CAR),
& SdimNC_CAR(3, itotNC_CAR),
& SdimNC_CAR(4, itotNC_CAR),
& unitNC_CAR(itotNC_CAR),
& lnamNC_CAR(itotNC_CAR)
endif
GOTO 980
990 continue
NtotNC_CAR = itotNC_CAR
NAMrat(1) = 'actual_range' ! "actual_range" is (min,max)
NvatNC_CAR(1) = 2
tit_NC_CAR = "Caraib outputs"
call UNscreate(fnamNC_CAR, tit_NC_CAR, &
NdimNC_CAR, nDFdim, MXdim, &
NAMdim, UNIdim, VALdim, &
MX_var, NtotNC_CAR, nameNC_CAR, &
SdimNC_CAR, unitNC_CAR, lnamNC_CAR, &
NattNC_CAR, NAMrat, NvatNC_CAR, &
ID__nc_CAR)
call UNscreate(fnamNC_CAR, tit_NC_CAR,
& NdimNC_CAR, nDFdim, MXdim,
& NAMdim, UNIdim, VALdim,
& MX_var, NtotNC_CAR, nameNC_CAR,
& SdimNC_CAR, unitNC_CAR, lnamNC_CAR,
& NattNC_CAR, NAMrat, NvatNC_CAR,
& ID__nc_CAR)
inquire(file=filename, exist=iostat)
inquire(file='./CARAIB_couplage/clim/Belgium/ecotxt.dat',
& exist=iostat)
open(unit=20, file=filename, status='unknown', action='read'
& , iostat=iostat)
open(unit=20, file='./CARAIB_couplage/clim/Belgium/ecotxt.dat',
& status='unknown', action='read', iostat=iostat)
DO i=1,mx
DO j=1,my
read(20,123)nbr_pixel,mar_lon(i,j),mar_lat(i,j),
& isuy(i,j),av_cla(i,j),av_sil(i,j)
& av_san(i,j),sh(i,j)
& isuy(i,j),av_cla(i,j),av_sil(i,j),
& av_san(i,j),topo(i,j),
& av_col(i,j),f_l(i,j)
enddo; enddo
123 format(i7,2(1x,f9.4),1x,i3,3(1x,f6.2),
& 1x,f5.0,1x,f5.2,1x,f6.3)
call UNwrite(ID__nc_CAR, 'time', 1, 1, 1, 1, date)
!add the vars that are in the ecotxt
call UNwrite(ID__nc_CAR, 'LON', 1, mx, my, 1, mar_lon)
call UNwrite(ID__nc_CAR, 'LAT', 1, mx, my, 1, mar_lat)
call UNwrite(ID__nc_CAR, 'SH', 1, mx, my, 1, sh)
call UNwrite(ID__nc_CAR, 'SH', 1, mx, my, 1, topo)
call UNwrite(ID__nc_CAR, 'FLAND', 1, mx, my, 1, f_l)
call UNwrite(ID__nc_CAR, 'FAO', 1, mx, my, 1, isuy)
call UNwrite(ID__nc_CAR, 'SILT', 1, mx, my, 1, av_sil)
......@@ -245,14 +265,14 @@
call UNwrite(ID__nc_CAR, 'HAR', 1, mx, my, 1, xdcharvest_2d)
call UNwrite(ID__nc_CAR, 'HAR2', 1, mx, my, PFT,ycharvest_2d )
call UNwrite(ID__nc_CAR, 'LAI', 1, mx, my, 1, tlamth_2d)
call UNwrite(ID__nc_CAR, 'LAI2', 1, mx, my, PFT, xlai)
call UNwrite(ID__nc_CAR, 'LAI2', 1, mx, my, PFT, xlai_2d)
call UNwrite(ID__nc_CAR, 'LAIB', 1, mx, my, 1, xmlai_2d)
!call UNwrite(ID__nc_CAR, 'LUDF', 1, mx, my, 1, ttzIB)
call UNwrite(ID__nc_CAR, 'LUCF', 1, mx, my, 1, z0mth_2d)
!call UNwrite(ID__nc_CAR, 'LUCF', 1, mx, my, 1, z0mth_2d)
call UNwrite(ID__nc_CAR, 'MAT', 1, mx, my, 1, maturity_2d)
call UNwrite(ID__nc_CAR, 'NBP', 1, mx, my, 1, xdnbp_2d)
call UNwrite(ID__nc_CAR, 'NEP', 1, mx, my, 1, xdnep_2d)
call UNwrite(ID__nc_CAR, 'NPP', 1, mx, my, 1, ynppf_2d)
call UNwrite(ID__nc_CAR, 'NPP', 1, mx, my, 1, xnpp_2d)
call UNwrite(ID__nc_CAR, 'NPP2', 1, mx, my, PFT, xdnpp_2d)
call UNwrite(ID__nc_CAR, 'PET', 1, mx, my, 1, petmth_2d)
call UNwrite(ID__nc_CAR, 'PFIR', 1, mx, my, 1, Pf_2d)
......@@ -308,11 +328,11 @@
if(ID__nc_ice /= -1) then
if(ID__nc_CAR /= -1) then
! + ************
call UNclose(ID__nc_ice)
call UNclose(ID__nc_CAR)
! + ************
ID__nc_ice = -1
ID__nc_CAR = -1
endif
end subroutine write_res
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment