From 72ebd566d7db37bbae314ca13948b747cb42c15a Mon Sep 17 00:00:00 2001 From: Whyborn Date: Mon, 12 Jan 2026 09:14:23 +1100 Subject: [PATCH] Change all instances of !$ to !, unless followed by OMP --- src/offline/CASAONLY_LUC.F90 | 8 +- src/offline/TumbaFluxnet.1.3_met.nc | Bin 4492760 -> 4492755 bytes src/offline/cable_cru_TRENDY.F90 | 74 ++-- src/offline/cable_initialise.F90 | 42 +-- src/offline/cable_input.F90 | 6 +- src/offline/cable_mpimaster.F90 | 174 ++++----- src/offline/cable_mpiworker.F90 | 58 +-- src/offline/cable_output.F90 | 482 ++++++++++++------------ src/offline/cable_plume_mip.F90 | 16 +- src/offline/cable_serial.F90 | 50 +-- src/offline/cable_weathergenerator.F90 | 8 +- src/offline/gridinfo_CSIRO_1x1.nc | Bin 41694260 -> 41694202 bytes src/offline/spincasacnp.F90 | 16 +- src/science/casa-cnp/casa_cnp.F90 | 42 +-- src/science/casa-cnp/casa_inout.F90 | 224 +++++------ src/science/gw_hydro/cable_gw_hydro.F90 | 122 +++--- src/science/misc/cable_climate.F90 | 26 +- src/science/pop/POP.F90 | 92 ++--- src/science/pop/POPLUC.F90 | 20 +- src/science/pop/pop_io.F90 | 60 +-- src/science/pop/pop_mpi.F90 | 10 +- src/science/sli/cable_sli_main.F90 | 12 +- src/science/sli/cable_sli_solve.F90 | 112 +++--- src/science/sli/cable_sli_utils.F90 | 40 +- src/shared/cable_LUC_EXPT.F90 | 12 +- src/shared/casa_offline_inout.F90 | 2 +- 26 files changed, 854 insertions(+), 854 deletions(-) diff --git a/src/offline/CASAONLY_LUC.F90 b/src/offline/CASAONLY_LUC.F90 index 62103fba6..d498c6da8 100644 --- a/src/offline/CASAONLY_LUC.F90 +++ b/src/offline/CASAONLY_LUC.F90 @@ -255,10 +255,10 @@ SUBROUTINE CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & CALL POP_IO( pop, casamet, YYYY, 'WRITE_EPI', & ( YYYY.EQ.cable_user%YearEnd ) ) -!!$ WHERE (pop%pop_grid(:)%cmass_sum_old.gt.0.1 .and. pop%pop_grid(:)%cmass_sum.gt.0.1 ) -!!$ casapool%Cplant(Iw,2) = casapool%Cplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99)) -!!$ casapool%Nplant(Iw,2) = casapool%Nplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99)) -!!$ ENDWHERE +!! WHERE (pop%pop_grid(:)%cmass_sum_old.gt.0.1 .and. pop%pop_grid(:)%cmass_sum.gt.0.1 ) +!! casapool%Cplant(Iw,2) = casapool%Cplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99)) +!! casapool%Nplant(Iw,2) = casapool%Nplant(Iw,2)*(1.0- min( POP%pop_grid(:)%cat_mortality/(POP%pop_grid(:)%cmass_sum_old),0.99)) +!! ENDWHERE CALL POP_LUC_CASA_transfer(POPLUC,POP,LUC_EXPT,casapool,casabal,casaflux,ktauday) diff --git a/src/offline/TumbaFluxnet.1.3_met.nc b/src/offline/TumbaFluxnet.1.3_met.nc index 9b7f34f07d00538d29d267a114350a372c0672ac..852040de639e6871d0e166ae8f88334dbdfdcb3b 100644 GIT binary patch delta 309 zcmXZPIZgsm0D$2DBMcxQtH{8B;?6dJqOxzs6L z;z-~aNt{SyntJ(EM$c9G-d?73X~(qnZ2uokx9o)`?M3=^Yi-O7bYzjkDbA3`IWBOC uD_r9Sw}@PJ1=p@|mS=%9-p`WRq{k=&T$U;jVXl8O)j delta 324 zcmYMqJ5B;o06@_UIyf?df((9O{60VtX2encCIJX^iQli!d3?N293HJzmH7rJPTJ@54)YG-_F zWMdEeIKUx}a14Po{=O_uaEctxkVgRyT%4nb3wXH16-p?hf+}jLqk$%_af24xxJ5@< Iqwd`N1=9y=RR910 diff --git a/src/offline/cable_cru_TRENDY.F90 b/src/offline/cable_cru_TRENDY.F90 index 02b85ea0d..5aac3d583 100644 --- a/src/offline/cable_cru_TRENDY.F90 +++ b/src/offline/cable_cru_TRENDY.F90 @@ -432,17 +432,17 @@ SUBROUTINE CRU_GET_FILENAME ( CRU, cyear, par, FN ) ! Build the rest of the filename according to the value of par, which references 11 possible ! types of met through the parameter names rain, lwdn, etc. -!$ SELECT CASE ( par ) -!$ CASE(rain) ; FN = TRIM(FN)//"/rain/cruncep2015_1_rain_"//cy//".daymean.nc" -!$ CASE(lwdn) ; FN = TRIM(FN)//"/lwdown/cruncep2015_1_lwdown_"//cy//".daymean.nc" -!$ CASE(swdn) ; FN = TRIM(FN)//"/swdown/cruncep2015_1_swdown_"//cy//".daymean.nc" -!$ CASE(pres) ; FN = TRIM(FN)//"/press/cruncep2015_1_press_"//cy//".daymean.nc" -!$ CASE(qair) ; FN = TRIM(FN)//"/qair/cruncep2015_1_qair_"//cy//".daymean.nc" -!$ CASE(tmax,PrevTmax) ; FN = TRIM(FN)//"/tmax/cruncep2015_1_tair_"//cy//".daymax.nc" -!$ CASE(tmin,NextTmin) ; FN = TRIM(FN)//"/tmin/cruncep2015_1_tair_"//cy//".daymin.nc" -!$ CASE(uwind) ; FN = TRIM(FN)//"/uwind/cruncep2015_1_uwind_"//cy//".daymean.nc" -!$ CASE(vwind) ; FN = TRIM(FN)//"/vwind/cruncep2015_1_vwind_"//cy//".daymean.nc" -!$ END SELECT +! SELECT CASE ( par ) +! CASE(rain) ; FN = TRIM(FN)//"/rain/cruncep2015_1_rain_"//cy//".daymean.nc" +! CASE(lwdn) ; FN = TRIM(FN)//"/lwdown/cruncep2015_1_lwdown_"//cy//".daymean.nc" +! CASE(swdn) ; FN = TRIM(FN)//"/swdown/cruncep2015_1_swdown_"//cy//".daymean.nc" +! CASE(pres) ; FN = TRIM(FN)//"/press/cruncep2015_1_press_"//cy//".daymean.nc" +! CASE(qair) ; FN = TRIM(FN)//"/qair/cruncep2015_1_qair_"//cy//".daymean.nc" +! CASE(tmax,PrevTmax) ; FN = TRIM(FN)//"/tmax/cruncep2015_1_tair_"//cy//".daymax.nc" +! CASE(tmin,NextTmin) ; FN = TRIM(FN)//"/tmin/cruncep2015_1_tair_"//cy//".daymin.nc" +! CASE(uwind) ; FN = TRIM(FN)//"/uwind/cruncep2015_1_uwind_"//cy//".daymean.nc" +! CASE(vwind) ; FN = TRIM(FN)//"/vwind/cruncep2015_1_vwind_"//cy//".daymean.nc" +! END SELECT SELECT CASE ( par ) @@ -624,11 +624,11 @@ SUBROUTINE OPEN_CRU_MET( CRU ) ! For S0_TRENDY and initialisation, calculate the required met year for repeatedly cycling through the ! 30 years of 1901-1930 spinup meteorology. For normal runs 1901-2015, MetYear = CYEAR. -!$ IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN -!$ MetYear = 1901 + MOD(CRU%CYEAR-RunStartYear,30) -!$ ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN -!$ MetYear = CRU%CYEAR -!$ ENDIF +! IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN +! MetYear = 1901 + MOD(CRU%CYEAR-RunStartYear,30) +! ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN +! MetYear = CRU%CYEAR +! ENDIF IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' ) & .OR. ( TRIM(CRU%Run) .EQ. 'S0_TRENDY_CO2') & .OR. ( TRIM(CRU%Run) .EQ. 'S0_TRENDY_Ndep' )) THEN @@ -742,13 +742,13 @@ SUBROUTINE CRU_GET_DAILY_MET( CRU, LastDayOfYear, LastYearOfMet ) ! Stop with error for anything else. -!$ IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN -!$ MetYear = 1901 + MOD(CRU%CYEAR-RunStartYear,30) -!$ ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN -!$ MetYear = CRU%CYEAR -!$ ELSE -!$ STOP 'Error in cable_cru.F90: CRU%Run not S0_TRENDY, S1_TRENDY, or 1901-2015' -!$ ENDIF +! IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN +! MetYear = 1901 + MOD(CRU%CYEAR-RunStartYear,30) +! ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN +! MetYear = CRU%CYEAR +! ELSE +! STOP 'Error in cable_cru.F90: CRU%Run not S0_TRENDY, S1_TRENDY, or 1901-2015' +! ENDIF !print *, "runstartyear, metyear", runstartyear, metyear @@ -888,11 +888,11 @@ SUBROUTINE CRU_GET_DAILY_MET( CRU, LastDayOfYear, LastYearOfMet ) t = 1 ! Time index is set to the first day of the next year ! Add one to the calculation of MetYear -!$ IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN -!$ NextMetYear = 1901 + MOD(CRU%CYEAR + 1 - RunStartYear,30) -!$ ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN -!$ NextMetYear = CRU%CYEAR + 1 -!$ ENDIF +! IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' )) THEN +! NextMetYear = 1901 + MOD(CRU%CYEAR + 1 - RunStartYear,30) +! ELSE IF ( TRIM(CRU%Run) .EQ. 'S2_TRENDY' ) THEN +! NextMetYear = CRU%CYEAR + 1 +! ENDIF IF ( TRIM(CRU%Run) .EQ. 'S0_TRENDY' .OR. ( TRIM(CRU%Run) .EQ. 'S1_TRENDY' ) & .OR. ( TRIM(CRU%Run) .EQ. 'S0_TRENDY_CO2') & .OR. ( TRIM(CRU%Run) .EQ. 'S0_TRENDY_Ndep' )) THEN @@ -1384,15 +1384,15 @@ SUBROUTINE CRU_GET_SUBDIURNAL_MET(CRU, MET, CurYear, ktau, kend, LastYearOfMet ) ! calculate snowfall based on total precip and air T !(ref Jin et al. Table II, Hyd Proc, 1999) -!$ if (WG%Temp(iland) > 2.5) then -!$ met%precip_sn(is:ie) = 0.0 -!$ elseif ((WG%Temp(iland) <= 2.5) .and. (WG%Temp(iland) > 2.0)) then -!$ met%precip_sn(is:ie) = 0.6* met%precip(is:ie) -!$ elseif ((WG%Temp(iland) <= 2.0) .and. (WG%Temp(iland) > 0.0)) then -!$ met%precip_sn(is:ie) = (1.0 - (54.62 - 0.2 *(WG%Temp(iland) + 273.15)))* met%precip(is:ie) ! this facr can be > 1 ! -!$ elseif (WG%Temp(iland) <= 0.0) then -!$ met%precip_sn(is:ie) = met%precip(is:ie) -!$ endif +! if (WG%Temp(iland) > 2.5) then +! met%precip_sn(is:ie) = 0.0 +! elseif ((WG%Temp(iland) <= 2.5) .and. (WG%Temp(iland) > 2.0)) then +! met%precip_sn(is:ie) = 0.6* met%precip(is:ie) +! elseif ((WG%Temp(iland) <= 2.0) .and. (WG%Temp(iland) > 0.0)) then +! met%precip_sn(is:ie) = (1.0 - (54.62 - 0.2 *(WG%Temp(iland) + 273.15)))* met%precip(is:ie) ! this facr can be > 1 ! +! elseif (WG%Temp(iland) <= 0.0) then +! met%precip_sn(is:ie) = met%precip(is:ie) +! endif IF (WG%Temp(iland) <= 0.0) THEN met%precip_sn(is:ie) = met%precip(is:ie) diff --git a/src/offline/cable_initialise.F90 b/src/offline/cable_initialise.F90 index 766e6bcce..bcab252b4 100644 --- a/src/offline/cable_initialise.F90 +++ b/src/offline/cable_initialise.F90 @@ -417,10 +417,10 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & ssnow%GWwb = 0.95*soil%ssat END IF -!$ IF(cable_user%SOIL_STRUC=='sli'.or.cable_user%FWSOIL_SWITCH=='Haverd2013') THEN -!$ CALL readpar(ncid_rin,'gamma',dummy,veg%gamma,filename%restart_in, & -!$ max_vegpatches,'def',from_restart,mp) -!$ ENDIF +! IF(cable_user%SOIL_STRUC=='sli'.or.cable_user%FWSOIL_SWITCH=='Haverd2013') THEN +! CALL readpar(ncid_rin,'gamma',dummy,veg%gamma,filename%restart_in, & +! max_vegpatches,'def',from_restart,mp) +! ENDIF IF(cable_user%SOIL_STRUC=='sli') THEN CALL readpar(ncid_rin,'S',dummy,ssnow%S,filename%restart_in, & @@ -437,23 +437,23 @@ SUBROUTINE get_restart_data(logn,ssnow,canopy,rough,bgc, & max_vegpatches,'snow',from_restart,mp) CALL readpar(ncid_rin,'sconds',dummy,ssnow%sconds,filename%restart_in, & max_vegpatches,'snow',from_restart,mp) -!$ CALL readpar(ncid_rin,'ZR',dummy,veg%ZR, & -!$ filename%restart_in,max_vegpatches,'def',from_restart,mp) -!$ CALL readpar(ncid_rin,'F10',dummy,veg%F10, & -!$ filename%restart_in,max_vegpatches,'def',from_restart,mp) -!$ CALL readpar(ncid_rin,'zeta',dummy,soil%zeta,filename%restart_in, & -!$ max_vegpatches,'def',from_restart,mp) -!$ CALL readpar(ncid_rin,'fsatmax',dummy,soil%fsatmax,filename%restart_in, & -!$ max_vegpatches,'def',from_restart,mp) -!$ CALL readpar(ncid_rin,'nhorizons',dummy,soil%nhorizons,filename%restart_in, & -!$ max_vegpatches,'def',from_restart,mp) -!$ ALLOCATE(var_r2(mp,ms)) -!$ CALL readpar(ncid_rin,'ishorizon',dummy,var_r2,filename%restart_in, & -!$ max_vegpatches,'ms',from_restart,mp) -!$ soil%ishorizon = int(var_r2) -!$ DEALLOCATE(var_r2) -!$ CALL readpar(ncid_rin,'clitt',dummy,veg%clitt,filename%restart_in, & -!$ max_vegpatches,'def',from_restart,mp) +! CALL readpar(ncid_rin,'ZR',dummy,veg%ZR, & +! filename%restart_in,max_vegpatches,'def',from_restart,mp) +! CALL readpar(ncid_rin,'F10',dummy,veg%F10, & +! filename%restart_in,max_vegpatches,'def',from_restart,mp) +! CALL readpar(ncid_rin,'zeta',dummy,soil%zeta,filename%restart_in, & +! max_vegpatches,'def',from_restart,mp) +! CALL readpar(ncid_rin,'fsatmax',dummy,soil%fsatmax,filename%restart_in, & +! max_vegpatches,'def',from_restart,mp) +! CALL readpar(ncid_rin,'nhorizons',dummy,soil%nhorizons,filename%restart_in, & +! max_vegpatches,'def',from_restart,mp) +! ALLOCATE(var_r2(mp,ms)) +! CALL readpar(ncid_rin,'ishorizon',dummy,var_r2,filename%restart_in, & +! max_vegpatches,'ms',from_restart,mp) +! soil%ishorizon = int(var_r2) +! DEALLOCATE(var_r2) +! CALL readpar(ncid_rin,'clitt',dummy,veg%clitt,filename%restart_in, & +! max_vegpatches,'def',from_restart,mp) ENDIF CALL readpar(ncid_rin,'cansto',dummy,canopy%cansto,filename%restart_in, & max_vegpatches,'def',from_restart,mp) diff --git a/src/offline/cable_input.F90 b/src/offline/cable_input.F90 index 84c3b6a66..80301b4cd 100644 --- a/src/offline/cable_input.F90 +++ b/src/offline/cable_input.F90 @@ -1138,9 +1138,9 @@ SUBROUTINE open_met_file(dels,koffset,kend,spinup, TFRZ) (ok,'Error finding LWdown units in met data file ' & //TRIM(filename%met)//' (SUBROUTINE open_met_file)') ! vh_js ! fixed bug in logic -!$ IF(metunits%LWdown(1:4)/='W/m2'.AND.metunits%LWdown(1:5) & -!$ /='W/m^2'.AND.metunits%LWdown(1:5)/='Wm^-2' & -!$ .AND.metunits%LWdown(1:4)/='Wm-2') THEN +! IF(metunits%LWdown(1:4)/='W/m2'.AND.metunits%LWdown(1:5) & +! /='W/m^2'.AND.metunits%LWdown(1:5)/='Wm^-2' & +! .AND.metunits%LWdown(1:4)/='Wm-2') THEN IF(.NOT.(metunits%LWdown(1:4)/='W/m2'.OR.metunits%LWdown(1:5) & /='W/m^2'.OR.metunits%LWdown(1:5)/='Wm^-2' & .OR.metunits%LWdown(1:4)/='Wm-2'.OR.metunits%SWdown(1:5) /= 'W m-2')) THEN diff --git a/src/offline/cable_mpimaster.F90 b/src/offline/cable_mpimaster.F90 index 591caba01..c09f3804f 100644 --- a/src/offline/cable_mpimaster.F90 +++ b/src/offline/cable_mpimaster.F90 @@ -748,22 +748,22 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) (TRIM(cable_user%MetType) .NE. 'gswp3') .AND. & (TRIM(cable_user%MetType) .NE. 'prin' )) CurYear = met%year(1) -!$ IF ( CASAONLY .AND. IS_CASA_TIME("dread", yyyy, iktau, kstart, koffset, & -!$ kend, ktauday, logn) ) THEN -!$ ! CLN READ FROM FILE INSTEAD ! -!$ WRITE(CYEAR,FMT="(I4)")CurYear + INT((ktau-kstart+koffset)/(LOY*ktauday)) -!$ ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' -!$ casa_it = NINT( REAL(iktau / ktauday) ) -!$ CALL read_casa_dump( ncfile, casamet, casaflux, casa_it, kend, .FALSE. ) -!$ ENDIF +! IF ( CASAONLY .AND. IS_CASA_TIME("dread", yyyy, iktau, kstart, koffset, & +! kend, ktauday, logn) ) THEN +! ! CLN READ FROM FILE INSTEAD ! +! WRITE(CYEAR,FMT="(I4)")CurYear + INT((ktau-kstart+koffset)/(LOY*ktauday)) +! ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' +! casa_it = NINT( REAL(iktau / ktauday) ) +! CALL read_casa_dump( ncfile, casamet, casaflux, casa_it, kend, .FALSE. ) +! ENDIF ! Zero out lai where there is no vegetation acc. to veg. index WHERE ( iveg%iveg(:) .GE. 14 ) iveg%vlai = 0. -!$ ! At first time step of year, set tile area according to updated LU areas -!$ IF (ktau == 1 .and. CABLE_USER%POPLUC) THEN -!$ CALL POPLUC_set_patchfrac(POPLUC,LUC_EXPT) -!$ ENDIF +! ! At first time step of year, set tile area according to updated LU areas +! IF (ktau == 1 .and. CABLE_USER%POPLUC) THEN +! CALL POPLUC_set_patchfrac(POPLUC,LUC_EXPT) +! ENDIF IF ( .NOT. CASAONLY ) THEN @@ -792,15 +792,15 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) CALL master_send_input (icomm, inp_ts, iktau) ! CALL MPI_Waitall (wnp, inp_req, inp_stats, ierr) -!$ IF ( ((.NOT.spinup).OR.(spinup.AND.spinConv)) .AND. & -!$ ( IS_CASA_TIME("dwrit", yyyy, oktau, kstart, & -!$ koffset, kend, ktauday, logn) ) ) THEN -!$ WRITE(CYEAR,FMT="(I4)") CurYear + INT((ktau-kstart)/(LOY*ktauday)) -!$ ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' -!$ CALL write_casa_dump( ncfile, casamet , casaflux, idoy, & -!$ kend/ktauday ) -!$ -!$ ENDIF +! IF ( ((.NOT.spinup).OR.(spinup.AND.spinConv)) .AND. & +! ( IS_CASA_TIME("dwrit", yyyy, oktau, kstart, & +! koffset, kend, ktauday, logn) ) ) THEN +! WRITE(CYEAR,FMT="(I4)") CurYear + INT((ktau-kstart)/(LOY*ktauday)) +! ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' +! CALL write_casa_dump( ncfile, casamet , casaflux, idoy, & +! kend/ktauday ) +! +! ENDIF IF (((.NOT.spinup).OR.(spinup.AND.spinConv)).AND. & MOD((ktau-kstart+1),ktauday)==0) THEN @@ -877,12 +877,12 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) new_sumbal = new_sumbal + SUM(bal%wbal)/mp + SUM(bal%ebal)/mp new_sumfpn = new_sumfpn + SUM(canopy%fpn)/mp new_sumfe = new_sumfe + SUM(canopy%fe)/mp -!$ if (ktau == kend-1) PRINT*, "time-space-averaged energy & water balances" -!$ if (ktau == kend-1) PRINT*,"Ebal_tot[Wm-2], Wbal_tot[mm]", & -!$ sum(bal%ebal_tot)/mp/count_bal, sum(bal%wbal_tot)/mp/count_bal -!$ if (ktau == kend-1) PRINT*, "time-space-averaged latent heat and net photosynthesis" -!$ if (ktau == kend-1) PRINT*, "sum_fe[Wm-2], sum_fpn[umol/m2/s]", & -!$ new_sumfe/count_bal, new_sumfpn/count_bal +! if (ktau == kend-1) PRINT*, "time-space-averaged energy & water balances" +! if (ktau == kend-1) PRINT*,"Ebal_tot[Wm-2], Wbal_tot[mm]", & +! sum(bal%ebal_tot)/mp/count_bal, sum(bal%wbal_tot)/mp/count_bal +! if (ktau == kend-1) PRINT*, "time-space-averaged latent heat and net photosynthesis" +! if (ktau == kend-1) PRINT*, "sum_fe[Wm-2], sum_fpn[umol/m2/s]", & +! new_sumfe/count_bal, new_sumfpn/count_bal ! check for Nans in biophysical outputs and abort if there are any IF (ANY( canopy%fe.NE. canopy%fe)) THEN @@ -1022,14 +1022,14 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) ENDIF END IF -!$ IF ( CABLE_USER%CASA_DUMP_WRITE ) THEN -!$ !CLN CHECK FOR LEAP YEAR -!$ WRITE(CYEAR,FMT="(I4)") CurYear + INT((ktau-kstart)/(LOY*ktauday)) -!$ ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' -!$ CALL write_casa_dump( ncfile, casamet , casaflux, idoy, & -!$ kend/ktauday ) -!$ -!$ ENDIF +! IF ( CABLE_USER%CASA_DUMP_WRITE ) THEN +! !CLN CHECK FOR LEAP YEAR +! WRITE(CYEAR,FMT="(I4)") CurYear + INT((ktau-kstart)/(LOY*ktauday)) +! ncfile = TRIM(casafile%c2cdumppath)//'c2c_'//CYEAR//'_dump.nc' +! CALL write_casa_dump( ncfile, casamet , casaflux, idoy, & +! kend/ktauday ) +! +! ENDIF IF (((.NOT.spinup).OR.(spinup.AND.spinConv)).AND. & MOD((ktau-kstart+1),ktauday)==0) THEN @@ -1212,8 +1212,8 @@ SUBROUTINE mpidrv_master (comm, dels, koffset, kend, PLUME, CRU) !CALL MPI_Waitall (wnp, recv_req, recv_stats, ierr) -!$ CALL casa_poolout( ktau, veg, soil, casabiome, & -!$ casapool, casaflux, casamet, casabal, phen ) +! CALL casa_poolout( ktau, veg, soil, casabiome, & +! casapool, casaflux, casamet, casabal, phen ) CALL casa_fluxout( nyear, veg, soil, casabal, casamet) if(.not.l_landuse) then @@ -1886,7 +1886,7 @@ SUBROUTINE master_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & & types(bidx), ierr) blen(bidx) = 1 -!$ +! bidx = bidx + 1 CALL MPI_Get_address (ssnow%thetai(off,1), displs(bidx), ierr) CALL MPI_Type_create_hvector (ms, r2len, r2stride, MPI_BYTE, & @@ -7518,14 +7518,14 @@ SUBROUTINE master_casa_dump_types(comm, casamet, casaflux, phen ) CALL MPI_Abort (comm, 0, ierr) END IF -!$ DO rank = 1, wnp -!$ -!$ CALL MPI_ISend (MPI_BOTTOM, 1, casa_dump_ts(rank), rank, 0, comm, & -!$ & inp_req(rank), ierr) -!$ -!$ END DO -!$ -!$ CALL MPI_Waitall (wnp, inp_req, inp_stats, ierr) +! DO rank = 1, wnp +! +! CALL MPI_ISend (MPI_BOTTOM, 1, casa_dump_ts(rank), rank, 0, comm, & +! & inp_req(rank), ierr) +! +! END DO +! +! CALL MPI_Waitall (wnp, inp_req, inp_stats, ierr) END SUBROUTINE master_casa_dump_types ! ############################################################################################################# @@ -8193,21 +8193,21 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,casabiome,casapool, & INTEGER :: k, j, l INTEGER :: rank, off, cnt, ierr -!$ if (.NOT.Allocated(LAIMax)) allocate(LAIMax(mp)) -!$ if (.NOT.Allocated(Cleafmean)) allocate(Cleafmean(mp)) -!$ if (.NOT.Allocated(Crootmean)) allocate(Crootmean(mp)) -!$ if (.NOT.Allocated(NPPtoGPP)) allocate(NPPtoGPP(mp)) -!$ if (.NOT.Allocated(Iw)) allocate(Iw(POP%np)) -!$ -!$ IF (cable_user%CALL_POP) THEN -!$ Iw = POP%Iwood -!$ ENDIF +! if (.NOT.Allocated(LAIMax)) allocate(LAIMax(mp)) +! if (.NOT.Allocated(Cleafmean)) allocate(Cleafmean(mp)) +! if (.NOT.Allocated(Crootmean)) allocate(Crootmean(mp)) +! if (.NOT.Allocated(NPPtoGPP)) allocate(NPPtoGPP(mp)) +! if (.NOT.Allocated(Iw)) allocate(Iw(POP%np)) +! +! IF (cable_user%CALL_POP) THEN +! Iw = POP%Iwood +! ENDIF ktauday=INT(24.0*3600.0/dels) nday=(kend-kstart+1)/ktauday -!$ ctime = 0 -!$ CALL zero_sum_casa(sum_casapool, sum_casaflux) -!$ count_sum_casa = 0 +! ctime = 0 +! CALL zero_sum_casa(sum_casapool, sum_casaflux) +! count_sum_casa = 0 myearspin = CABLE_USER%YEAREND - CABLE_USER%YEARSTART + 1 @@ -8262,35 +8262,35 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,casabiome,casapool, & -!$ ! zero annual sums -!$ if (idoy==1) CALL casa_cnpflux(casaflux,casapool,casabal,.TRUE.) - -!$ CALL biogeochem(ktau,dels,idoy,LALLOC,veg,soil,casabiome,casapool,casaflux, & -!$ casamet,casabal,phen,POP,climate,xnplimit,xkNlimiting,xklitter, & -!$ xksoil,xkleaf,xkleafcold,xkleafdry,& -!$ cleaf2met,cleaf2str,croot2met,croot2str,cwood2cwd, & -!$ nleaf2met,nleaf2str,nroot2met,nroot2str,nwood2cwd, & -!$ pleaf2met,pleaf2str,proot2met,proot2str,pwood2cwd) -!$ -!$ ! update time-aggregates of casa pools and fluxes -!$ CALL update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, & -!$ & .TRUE. , .FALSE., 1) -!$ count_sum_casa = count_sum_casa + 1 - +! ! zero annual sums +! if (idoy==1) CALL casa_cnpflux(casaflux,casapool,casabal,.TRUE.) - -!$ ! accumulate annual variables for use in POP -!$ IF(idoy==1 ) THEN -!$ casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 ! (assumes 70% of wood NPP is allocated above ground) -!$ LAImax = casamet%glai -!$ Cleafmean = casapool%cplant(:,1)/real(mdyear)/1000. -!$ Crootmean = casapool%cplant(:,3)/real(mdyear)/1000. -!$ ELSE -!$ casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 -!$ LAImax = max(casamet%glai, LAImax) -!$ Cleafmean = Cleafmean + casapool%cplant(:,1)/real(mdyear)/1000. -!$ Crootmean = Crootmean +casapool%cplant(:,3)/real(mdyear)/1000. -!$ ENDIF +! CALL biogeochem(ktau,dels,idoy,LALLOC,veg,soil,casabiome,casapool,casaflux, & +! casamet,casabal,phen,POP,climate,xnplimit,xkNlimiting,xklitter, & +! xksoil,xkleaf,xkleafcold,xkleafdry,& +! cleaf2met,cleaf2str,croot2met,croot2str,cwood2cwd, & +! nleaf2met,nleaf2str,nroot2met,nroot2str,nwood2cwd, & +! pleaf2met,pleaf2str,proot2met,proot2str,pwood2cwd) +! +! ! update time-aggregates of casa pools and fluxes +! CALL update_sum_casa(sum_casapool, sum_casaflux, casapool, casaflux, & +! & .TRUE. , .FALSE., 1) +! count_sum_casa = count_sum_casa + 1 + + + +! ! accumulate annual variables for use in POP +! IF(idoy==1 ) THEN +! casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 ! (assumes 70% of wood NPP is allocated above ground) +! LAImax = casamet%glai +! Cleafmean = casapool%cplant(:,1)/real(mdyear)/1000. +! Crootmean = casapool%cplant(:,3)/real(mdyear)/1000. +! ELSE +! casaflux%stemnpp = casaflux%stemnpp + casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 +! LAImax = max(casamet%glai, LAImax) +! Cleafmean = Cleafmean + casapool%cplant(:,1)/real(mdyear)/1000. +! Crootmean = Crootmean +casapool%cplant(:,3)/real(mdyear)/1000. +! ENDIF IF(idoy==mdyear) THEN ! end of year @@ -8376,7 +8376,7 @@ SUBROUTINE master_CASAONLY_LUC( dels,kstart,kend,veg,casabiome,casapool, & ! workers call POP here -!$ CALL POPdriver(casaflux,casabal,veg, POP) +! CALL POPdriver(casaflux,casabal,veg, POP) CALL master_receive_pop(POP, ocomm) diff --git a/src/offline/cable_mpiworker.F90 b/src/offline/cable_mpiworker.F90 index 030f62af1..ec693d10c 100644 --- a/src/offline/cable_mpiworker.F90 +++ b/src/offline/cable_mpiworker.F90 @@ -452,11 +452,11 @@ SUBROUTINE mpidrv_worker (comm) ! somethings (e.g. CASA-CNP) only need to be done once per day ktauday=INT(24.0*3600.0/dels) -!$ idoy = mod(ktau/ktauday,365) -!$ IF(idoy==0) idoy=365 -!$ -!$ ! needed for CASA-CNP -!$ nyear =INT((kend-kstart+1)/(365*ktauday)) +! idoy = mod(ktau/ktauday,365) +! IF(idoy==0) idoy=365 +! +! ! needed for CASA-CNP +! nyear =INT((kend-kstart+1)/(365*ktauday)) ! some things (e.g. CASA-CNP) only need to be done once per day idoy =INT( MOD((REAL(ktau+koffset)/REAL(ktauday)),REAL(LOY))) @@ -1159,7 +1159,7 @@ SUBROUTINE worker_cable_params (comm,met,air,ssnow,veg,bgc,soil,canopy,& bidx = bidx + 1 CALL MPI_Get_address (ssnow%Tsoil, displs(bidx), ierr) blen(bidx) = ms * r2len -!$ +! bidx = bidx + 1 CALL MPI_Get_address (ssnow%thetai, displs(bidx), ierr) blen(bidx) = ms * r2len @@ -6308,7 +6308,7 @@ SUBROUTINE worker_climate_types (comm, climate, ktauday ) types(bidx) = MPI_BYTE -!$types = MPI_BYTE +!types = MPI_BYTE ! MPI: sanity check IF (bidx /= ntyp) THEN WRITE (*,*) 'worker: invalid number of climate fields, fix it!' @@ -6350,7 +6350,7 @@ SUBROUTINE worker_climate_types (comm, climate, ktauday ) RETURN END SUBROUTINE worker_climate_types -!$ +! ! MPI: creates restart_t type to send to the master the fields ! that are only required for the restart file but not included in the ! results sent at the end of each time step @@ -6634,13 +6634,13 @@ SUBROUTINE worker_casa_dump_types(comm, casamet, casaflux, phen) DEALLOCATE(displs) DEALLOCATE(blen) -!$ ! if anything went wrong the master will mpi_abort -!$ ! which mpi_recv below is going to catch... -!$ ! so, now receive all the parameters -!$ CALL MPI_Recv (MPI_BOTTOM, 1, casa_dump_t, 0, 0, comm, stat, ierr) -!$ -!$ ! finally free the MPI type -!$ CALL MPI_Type_Free (casa_dump_t, ierr) +! ! if anything went wrong the master will mpi_abort +! ! which mpi_recv below is going to catch... +! ! so, now receive all the parameters +! CALL MPI_Recv (MPI_BOTTOM, 1, casa_dump_t, 0, 0, comm, stat, ierr) +! +! ! finally free the MPI type +! CALL MPI_Type_Free (casa_dump_t, ierr) ! all casa parameters have been received from the master by now @@ -6768,13 +6768,13 @@ SUBROUTINE worker_casa_LUC_types(comm, casapool, casabal) DEALLOCATE(displs) DEALLOCATE(blen) -!$ ! if anything went wrong the master will mpi_abort -!$ ! which mpi_recv below is going to catch... -!$ ! so, now receive all the parameters -!$ CALL MPI_Recv (MPI_BOTTOM, 1, casa_dump_t, 0, 0, comm, stat, ierr) -!$ -!$ ! finally free the MPI type -!$ CALL MPI_Type_Free (casa_dump_t, ierr) +! ! if anything went wrong the master will mpi_abort +! ! which mpi_recv below is going to catch... +! ! so, now receive all the parameters +! CALL MPI_Recv (MPI_BOTTOM, 1, casa_dump_t, 0, 0, comm, stat, ierr) +! +! ! finally free the MPI type +! CALL MPI_Type_Free (casa_dump_t, ierr) ! all casa parameters have been received from the master by now @@ -7050,7 +7050,7 @@ SUBROUTINE worker_spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapoo pleaf2met,pleaf2str,proot2met,proot2str,pwood2cwd) IF (cable_user%CALL_POP .AND. POP%np.GT.0) THEN ! CALL_POP -!$ ! accumulate annual variables for use in POP +! ! accumulate annual variables for use in POP IF(MOD(ktau/ktauday,LOY)==1 ) THEN casaflux%stemnpp = casaflux%cnpp * casaflux%fracCalloc(:,2) * 0.7 ! (assumes 70% of wood NPP is allocated above ground) casabal%LAImax = casamet%glai @@ -7365,11 +7365,11 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & CALL MPI_Comm_rank (icomm, rank, ierr) WRITE(logn,*) WRITE(logn,*) 'rank receiving pop_grid from master', rank -!$ write(logn,*) 'b4 MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum -!$ write(logn,*) 'b4 MPI_Recv, pop_t LU: ', POP%pop_grid%LU +! write(logn,*) 'b4 MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum +! write(logn,*) 'b4 MPI_Recv, pop_t LU: ', POP%pop_grid%LU CALL MPI_Recv( POP%pop_grid(1), POP%np, pop_t, 0, 0, icomm, stat, ierr ) -!$ write(logn,*) -!$ write(logn,*) 'after MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum +! write(logn,*) +! write(logn,*) 'after MPI_Recv, pop_t cmass: ', POP%pop_grid%cmass_sum WRITE(logn,*) 'after MPI_Recv, pop_t ' CALL flush(logn) IF (cable_user%CALL_POP .AND. POP%np.GT.0) THEN ! CALL_POP @@ -7377,8 +7377,8 @@ SUBROUTINE worker_CASAONLY_LUC( dels,kstart,kend,veg,soil,casabiome,casapool, & CALL POPdriver(casaflux,casabal,veg, POP) ENDIF -!$ write(logn,*) -!$ write(logn,*) 'after POPstep cmass: ', POP%pop_grid%cmass_sum +! write(logn,*) +! write(logn,*) 'after POPstep cmass: ', POP%pop_grid%cmass_sum WRITE(logn,*) 'after POPstep ', POP%pop_grid%cmass_sum CALL flush(logn) CALL worker_send_pop (POP, ocomm) diff --git a/src/offline/cable_output.F90 b/src/offline/cable_output.F90 index b7ada0c57..b81524d05 100644 --- a/src/offline/cable_output.F90 +++ b/src/offline/cable_output.F90 @@ -2695,24 +2695,24 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, 'Vegetation type', .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) CALL define_ovar(ncid_restart, rpid%isoil, 'isoil', '-', & 'Soil type', .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%clay, 'clay', '-', & -!$ 'Fraction of soil which is clay', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%sand, 'sand', '-', & -!$ 'Fraction of soil which is sand', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%silt, 'silt', '-', & -!$ 'Fraction of soil which is silt', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%ssat, 'ssat', '-', & -!$ 'Fraction of soil volume which is water @ saturation', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%sfc, 'sfc', '-', & -!$ 'Fraction of soil volume which is water @ field capacity', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%swilt, 'swilt', '-', & -!$ 'Fraction of soil volume which is water @ wilting point', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%clay, 'clay', '-', & +! 'Fraction of soil which is clay', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%sand, 'sand', '-', & +! 'Fraction of soil which is sand', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%silt, 'silt', '-', & +! 'Fraction of soil which is silt', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%ssat, 'ssat', '-', & +! 'Fraction of soil volume which is water @ saturation', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%sfc, 'sfc', '-', & +! 'Fraction of soil volume which is water @ field capacity', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%swilt, 'swilt', '-', & +! 'Fraction of soil volume which is water @ wilting point', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) ! zse (depth of each soil layer): ok = NF90_DEF_VAR(ncid_restart, 'zse', NF90_FLOAT, (/soilID/), rpid%zse) IF (ok /= NF90_NOERR) CALL nc_abort & @@ -2721,136 +2721,136 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, ok = NF90_PUT_ATT(ncid_restart, rpid%zse, "long_name", & "Depth of each soil layer") ok = NF90_PUT_ATT(ncid_restart, rpid%zse, "units", "m") -!$ CALL define_ovar(ncid_restart, rpid%froot, 'froot', '-', & -!$ 'Fraction of roots in each soil layer', & -!$ .TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%bch, 'bch', '-', & -!$ 'Parameter b, Campbell eqn 1985', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%hyds, 'hyds', 'm/s', & -!$ 'Hydraulic conductivity @ saturation', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%sucs, 'sucs', 'm', & -!$ 'Suction @ saturation', .TRUE., & -!$ 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%css, 'css', 'J/kg/C', & -!$ 'Heat capacity of soil minerals', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%rhosoil, 'rhosoil', 'kg/m^3', & -!$ 'Density of soil minerals', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%rs20, 'rs20', '-', & -!$ 'Soil respiration coefficient at 20C', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%froot, 'froot', '-', & +! 'Fraction of roots in each soil layer', & +! .TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%bch, 'bch', '-', & +! 'Parameter b, Campbell eqn 1985', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%hyds, 'hyds', 'm/s', & +! 'Hydraulic conductivity @ saturation', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%sucs, 'sucs', 'm', & +! 'Suction @ saturation', .TRUE., & +! 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%css, 'css', 'J/kg/C', & +! 'Heat capacity of soil minerals', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%rhosoil, 'rhosoil', 'kg/m^3', & +! 'Density of soil minerals', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%rs20, 'rs20', '-', & +! 'Soil respiration coefficient at 20C', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) CALL define_ovar(ncid_restart, rpid%albsoil, 'albsoil', '-', & 'Soil reflectance', .TRUE., & radID, 'radiation', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%hc, 'hc', 'm', & -!$ 'Height of canopy', .TRUE., & -!$ 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%canst1, 'canst1', 'mm/LAI', & -!$ 'Max water intercepted by canopy', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%dleaf, 'dleaf', 'm', & -!$ 'Chararacteristic length of leaf', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%frac4, 'frac4', '-', & -!$ 'Fraction of plants which are C4', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%ejmax, 'ejmax', 'mol/m^2/s', & -!$ 'Max potential electron transport rate top leaf', .TRUE., & -!$ 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%vcmax, 'vcmax', 'mol/m^2/s', & -!$ 'Maximum RuBP carboxylation rate top leaf', .TRUE., & -!$ 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%rp20, 'rp20', '-', & -!$ 'Plant respiration coefficient at 20C', .TRUE., 'real', & -!$ 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%g0, 'g0', '-', & -!$ 'g0 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& -!$ 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 -!$ CALL define_ovar(ncid_restart, rpid%g1, 'g1', '-', & -!$ 'g1 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& -!$ 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 -!$ CALL define_ovar(ncid_restart, rpid%rpcoef, 'rpcoef', '1/C', & -!$ 'Temperature coef nonleaf plant respiration', .TRUE., & -!$ 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%shelrb, 'shelrb', '-', & -!$ 'Sheltering factor', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%xfang, 'xfang', '-', & -!$ 'Leaf angle parameter', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%wai, 'wai', '-', & -!$ 'Wood area index', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%vegcf, 'vegcf', '-', & -!$ 'vegcf', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%extkn, 'extkn', '-', & -!$ 'Extinction coef for vertical nitrogen profile', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%tminvj, 'tminvj', 'C', & -!$ 'Min temperature for the start of photosynthesis', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%tmaxvj, 'tmaxvj', 'C', & -!$ 'Max temperature for the start of photosynthesis', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%vbeta, 'vbeta', '-', & -!$ 'Stomatal sensitivity to soil water', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%xalbnir, 'xalbnir', '-', & -!$ 'modifier for albedo in near ir band', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ ! ratecp (Plant carbon rate constant): -!$ ok = NF90_DEF_VAR(ncid_restart, 'ratecp', NF90_FLOAT, (/plantcarbID/), & -!$ rpid%ratecp) -!$ IF (ok /= NF90_NOERR) CALL nc_abort & -!$ (ok, 'Error defining ratecp variable in restart file. '// & -!$ '(SUBROUTINE create_restart)') -!$ ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "long_name", & -!$ "Plant carbon rate constant") -!$ ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "units", "1/year") -!$ ! ratecs (Soil carbon rate constant): -!$ ok = NF90_DEF_VAR(ncid_restart, 'ratecs', NF90_FLOAT, (/soilcarbID/), & -!$ rpid%ratecs) -!$ IF (ok /= NF90_NOERR) CALL nc_abort & -!$ (ok, 'Error defining ratecs variable in restart file. '// & -!$ '(SUBROUTINE create_restart)') -!$ ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "long_name", & -!$ "Soil carbon rate constant") -!$ ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "units", "1/year") -!$ CALL define_ovar(ncid_restart, rpid%meth, 'meth', '-', & -!$ 'Canopy turbulence parameterisation switch', & -!$ .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%za_uv, 'za_uv', 'm', & -!$ 'Reference height (lowest atm. model layer) for momentum', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart, rpid%za_tq, 'za_tq', 'm', & -!$ 'Reference height (lowest atm. model layer) for scalars', & -!$ .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%hc, 'hc', 'm', & +! 'Height of canopy', .TRUE., & +! 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%canst1, 'canst1', 'mm/LAI', & +! 'Max water intercepted by canopy', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%dleaf, 'dleaf', 'm', & +! 'Chararacteristic length of leaf', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%frac4, 'frac4', '-', & +! 'Fraction of plants which are C4', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%ejmax, 'ejmax', 'mol/m^2/s', & +! 'Max potential electron transport rate top leaf', .TRUE., & +! 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%vcmax, 'vcmax', 'mol/m^2/s', & +! 'Maximum RuBP carboxylation rate top leaf', .TRUE., & +! 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%rp20, 'rp20', '-', & +! 'Plant respiration coefficient at 20C', .TRUE., 'real', & +! 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%g0, 'g0', '-', & +! 'g0 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& +! 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 +! CALL define_ovar(ncid_restart, rpid%g1, 'g1', '-', & +! 'g1 term in Medlyn Stomatal Cond. Param', .TRUE.,'real',& +! 0, 0, 0, mpID, dummy, .TRUE.) ! Ticket #56 +! CALL define_ovar(ncid_restart, rpid%rpcoef, 'rpcoef', '1/C', & +! 'Temperature coef nonleaf plant respiration', .TRUE., & +! 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%shelrb, 'shelrb', '-', & +! 'Sheltering factor', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%xfang, 'xfang', '-', & +! 'Leaf angle parameter', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%wai, 'wai', '-', & +! 'Wood area index', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%vegcf, 'vegcf', '-', & +! 'vegcf', .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%extkn, 'extkn', '-', & +! 'Extinction coef for vertical nitrogen profile', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%tminvj, 'tminvj', 'C', & +! 'Min temperature for the start of photosynthesis', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%tmaxvj, 'tmaxvj', 'C', & +! 'Max temperature for the start of photosynthesis', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%vbeta, 'vbeta', '-', & +! 'Stomatal sensitivity to soil water', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%xalbnir, 'xalbnir', '-', & +! 'modifier for albedo in near ir band', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! ! ratecp (Plant carbon rate constant): +! ok = NF90_DEF_VAR(ncid_restart, 'ratecp', NF90_FLOAT, (/plantcarbID/), & +! rpid%ratecp) +! IF (ok /= NF90_NOERR) CALL nc_abort & +! (ok, 'Error defining ratecp variable in restart file. '// & +! '(SUBROUTINE create_restart)') +! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "long_name", & +! "Plant carbon rate constant") +! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecp, "units", "1/year") +! ! ratecs (Soil carbon rate constant): +! ok = NF90_DEF_VAR(ncid_restart, 'ratecs', NF90_FLOAT, (/soilcarbID/), & +! rpid%ratecs) +! IF (ok /= NF90_NOERR) CALL nc_abort & +! (ok, 'Error defining ratecs variable in restart file. '// & +! '(SUBROUTINE create_restart)') +! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "long_name", & +! "Soil carbon rate constant") +! ok = NF90_PUT_ATT(ncid_restart, rpid%ratecs, "units", "1/year") +! CALL define_ovar(ncid_restart, rpid%meth, 'meth', '-', & +! 'Canopy turbulence parameterisation switch', & +! .TRUE., 'integer', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%za_uv, 'za_uv', 'm', & +! 'Reference height (lowest atm. model layer) for momentum', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart, rpid%za_tq, 'za_tq', 'm', & +! 'Reference height (lowest atm. model layer) for scalars', & +! .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) CALL define_ovar(ncid_restart, gwID, 'GWwb', 'mm3/mm3','GW water content', & .TRUE., 'real', 0, 0, 0, mpID, dummy, .TRUE.) -!$ IF(cable_user%SOIL_STRUC=='sli'.OR.cable_user%FWSOIL_SWITCH=='Haverd2013') THEN -!$ CALL define_ovar(ncid_restart,rpid%gamma,'gamma','-', & -!$ 'Parameter in root efficiency function (Lai and Katul 2000)', & -!$ .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -!$ ENDIF +! IF(cable_user%SOIL_STRUC=='sli'.OR.cable_user%FWSOIL_SWITCH=='Haverd2013') THEN +! CALL define_ovar(ncid_restart,rpid%gamma,'gamma','-', & +! 'Parameter in root efficiency function (Lai and Katul 2000)', & +! .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! ENDIF ! Soil-Litter-Iso soil model IF(cable_user%SOIL_STRUC=='sli') THEN ! Parameters for SLI: -!$ CALL define_ovar(ncid_restart,rpid%nhorizons,'nhorizons','-', & -!$ 'Number of soil horizons',.TRUE.,'integer',0,0,0,mpID,dummy,.TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%zeta,'zeta','[ ]', & -!$ 'exponent factor in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%fsatmax,'fsatmax','[ ]', & -!$ 'param in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%ishorizon,'ishorizon','-', & -!$ 'Horizon number',.TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%clitt,'clitt','tC/ha', & -!$ 'Litter layer carbon content',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%ZR,'ZR','cm', & -!$ 'Maximum rooting depth',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) -!$ CALL define_ovar(ncid_restart,rpid%F10,'F10','-', & -!$ 'Fraction of roots in top 10 cm', & -!$ .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%nhorizons,'nhorizons','-', & +! 'Number of soil horizons',.TRUE.,'integer',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%zeta,'zeta','[ ]', & +! 'exponent factor in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%fsatmax,'fsatmax','[ ]', & +! 'param in Topmodel eq',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%ishorizon,'ishorizon','-', & +! 'Horizon number',.TRUE., soilID, 'soil', 0, 0, 0, mpID, dummy, .TRUE.) +! CALL define_ovar(ncid_restart,rpid%clitt,'clitt','tC/ha', & +! 'Litter layer carbon content',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%ZR,'ZR','cm', & +! 'Maximum rooting depth',.TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) +! CALL define_ovar(ncid_restart,rpid%F10,'F10','-', & +! 'Fraction of roots in top 10 cm', & +! .TRUE.,'real',0,0,0,mpID,dummy,.TRUE.) ! Variables for SLI: CALL define_ovar(ncid_restart,SID,'S','-',& 'Fractional soil moisture content relative to saturated value', & @@ -2942,37 +2942,37 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, CALL check_and_write(rpid%isoil, 'isoil', REAL(soil%isoilm, 4), & ranges%isoil, patchout_var, out_settings) out_settings%dimswitch = "real" -!$ CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & -!$ ranges%bch, patchout_var, out_settings) -!$ CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & -!$ ranges%bch, patchout_var, out_settings) -!$ CALL check_and_write(rpid%clay, 'clay', REAL(soil%clay, 4), & -!$ ranges%clay, patchout_var, out_settings) -!$ CALL check_and_write(rpid%sand, 'sand', REAL(soil%sand, 4), & -!$ ranges%sand, patchout_var, out_settings) -!$ CALL check_and_write(rpid%silt, 'silt', REAL(soil%silt, 4), & -!$ ranges%silt, patchout_var, out_settings) -!$ CALL check_and_write(rpid%css, 'css', REAL(soil%css, 4), & -!$ ranges%css, patchout_var, out_settings) -!$ CALL check_and_write(rpid%rhosoil, 'rhosoil', & -!$ REAL(soil%rhosoil, 4), ranges%rhosoil, patchout_var, & -!$ out_settings) -!$ CALL check_and_write(rpid%hyds, 'hyds', REAL(soil%hyds, 4), & -!$ ranges%hyds, patchout_var, out_settings) -!$ CALL check_and_write(rpid%sucs, 'sucs', REAL(soil%sucs, 4), & -!$ ranges%sucs, patchout_var, out_settings) -!$ CALL check_and_write(rpid%rs20, 'rs20', REAL(veg%rs20, 4), & -!$ ranges%rs20, patchout_var, out_settings) -!$ CALL check_and_write(rpid%ssat, 'ssat', REAL(soil%ssat, 4), & -!$ ranges%ssat, patchout_var, out_settings) -!$ CALL check_and_write(rpid%sfc, 'sfc', REAL(soil%sfc, 4), & -!$ ranges%sfc, patchout_var, out_settings) -!$ CALL check_and_write(rpid%swilt, 'swilt', REAL(soil%swilt, 4), & -!$ ranges%swilt, patchout_var, out_settings) +! CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & +! ranges%bch, patchout_var, out_settings) +! CALL check_and_write(rpid%bch, 'bch', REAL(soil%bch, 4), & +! ranges%bch, patchout_var, out_settings) +! CALL check_and_write(rpid%clay, 'clay', REAL(soil%clay, 4), & +! ranges%clay, patchout_var, out_settings) +! CALL check_and_write(rpid%sand, 'sand', REAL(soil%sand, 4), & +! ranges%sand, patchout_var, out_settings) +! CALL check_and_write(rpid%silt, 'silt', REAL(soil%silt, 4), & +! ranges%silt, patchout_var, out_settings) +! CALL check_and_write(rpid%css, 'css', REAL(soil%css, 4), & +! ranges%css, patchout_var, out_settings) +! CALL check_and_write(rpid%rhosoil, 'rhosoil', & +! REAL(soil%rhosoil, 4), ranges%rhosoil, patchout_var, & +! out_settings) +! CALL check_and_write(rpid%hyds, 'hyds', REAL(soil%hyds, 4), & +! ranges%hyds, patchout_var, out_settings) +! CALL check_and_write(rpid%sucs, 'sucs', REAL(soil%sucs, 4), & +! ranges%sucs, patchout_var, out_settings) +! CALL check_and_write(rpid%rs20, 'rs20', REAL(veg%rs20, 4), & +! ranges%rs20, patchout_var, out_settings) +! CALL check_and_write(rpid%ssat, 'ssat', REAL(soil%ssat, 4), & +! ranges%ssat, patchout_var, out_settings) +! CALL check_and_write(rpid%sfc, 'sfc', REAL(soil%sfc, 4), & +! ranges%sfc, patchout_var, out_settings) +! CALL check_and_write(rpid%swilt, 'swilt', REAL(soil%swilt, 4), & +! ranges%swilt, patchout_var, out_settings) ! Soil dimensioned variables/parameters: out_settings%dimswitch = "soil" -!$ CALL check_and_write(rpid%froot, 'froot', REAL(veg%froot, 4), & -!$ ranges%froot, patchout_var, out_settings) +! CALL check_and_write(rpid%froot, 'froot', REAL(veg%froot, 4), & +! ranges%froot, patchout_var, out_settings) !~ ssnow !~~ Soil dimensioned variables/parameters: @@ -3012,64 +3012,64 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, out_settings%dimswitch = "radiation" CALL check_and_write(rpid%albsoil, 'albsoil', & REAL(soil%albsoil, 4), ranges%albsoil, patchout_var, out_settings) -!$ out_settings%dimswitch = "real" -!$ CALL check_and_write(rpid%canst1, 'canst1', REAL(veg%canst1, 4), & -!$ ranges%canst1, patchout_var, out_settings) -!$ CALL check_and_write(rpid%dleaf, 'dleaf', REAL(veg%dleaf, 4), & -!$ ranges%dleaf, patchout_var, out_settings) -!$ CALL check_and_write(rpid%ejmax, 'ejmax', REAL(veg%ejmax, 4), & -!$ ranges%ejmax, patchout_var, out_settings) -!$ CALL check_and_write(rpid%vcmax, 'vcmax', REAL(veg%vcmax, 4), & -!$ ranges%vcmax, patchout_var, out_settings) -!$ CALL check_and_write(rpid%frac4, 'frac4', REAL(veg%frac4, 4), & -!$ ranges%frac4, patchout_var, out_settings) -!$ CALL check_and_write(rpid%hc, 'hc', REAL(veg%hc, 4), & -!$ ranges%hc, patchout_var, out_settings) -!$ CALL check_and_write(rpid%rp20, 'rp20', REAL(veg%rp20, 4), & -!$ ranges%rp20, patchout_var, out_settings) -!$ CALL check_and_write(rpid%g0, 'g0', REAL(veg%g0, 4), & -!$ ranges%g0, patchout_var, out_settings) ! Ticket #56 -!$ CALL check_and_write(rpid%g1, 'g1', REAL(veg%g1, 4), & -!$ ranges%g1, patchout_var, out_settings) ! Ticket #56 -!$ CALL check_and_write(rpid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & -!$ ranges%rpcoef, patchout_var, out_settings) -!$ CALL check_and_write(rpid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & -!$ ranges%shelrb, patchout_var, out_settings) -!$ CALL check_and_write(rpid%xfang, 'xfang', REAL(veg%xfang, 4), & -!$ ranges%xfang, patchout_var, out_settings) -!$ CALL check_and_write(rpid%wai, 'wai', REAL(veg%wai, 4), & -!$ ranges%wai, patchout_var, out_settings) -!$ CALL check_and_write(rpid%vegcf, 'vegcf', REAL(veg%vegcf, 4), & -!$ ranges%vegcf, patchout_var, out_settings) -!$ CALL check_and_write(rpid%extkn, 'extkn', REAL(veg%extkn, 4), & -!$ ranges%extkn, patchout_var, out_settings) -!$ CALL check_and_write(rpid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & -!$ ranges%tminvj, patchout_var, out_settings) -!$ CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & -!$ ranges%tmaxvj, patchout_var, out_settings) -!$ CALL check_and_write(rpid%vbeta, 'vbeta', REAL(veg%vbeta, 4), & -!$ ranges%vbeta, patchout_var, out_settings) -!$ CALL check_and_write(rpid%xalbnir, 'xalbnir', & -!$ REAL(veg%xalbnir, 4), ranges%xalbnir, patchout_var, & -!$ out_settings) -!$ CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & -!$ ranges%tmaxvj, patchout_var, out_settings) -!$ ok = NF90_PUT_VAR(rpid%ratecp, REAL(bgc%ratecp, 4)) -!$ IF (ok /= NF90_NOERR) CALL nc_abort(ok, & -!$ 'Error writing ratecp parameter to ' & -!$ //TRIM(frst_out)//'(SUBROUTINE create_restart)') -!$ ok = NF90_PUT_VAR(rpid%ratecs, REAL(bgc%ratecs, 4)) -!$ IF (ok /= NF90_NOERR) CALL nc_abort(ok, & -!$ 'Error writing ratecs parameter to ' & -!$ //TRIM(frst_out)//'(SUBROUTINE create_restart)') -!$ out_settings%dimswitch = "integer" -!$ CALL check_and_write(rpid%meth, 'meth', REAL(veg%meth, 4), & -!$ ranges%meth, patchout_var, out_settings) -!$ out_settings%dimswitch = "real" -!$ CALL check_and_write(rpid%za_uv, 'za_uv', REAL(rough%za_uv, 4), & -!$ ranges%za, patchout_var, out_settings) -!$ CALL check_and_write(rpid%za_tq, 'za_tq', REAL(rough%za_tq, 4), & -!$ ranges%za, patchout_var, out_settings) +! out_settings%dimswitch = "real" +! CALL check_and_write(rpid%canst1, 'canst1', REAL(veg%canst1, 4), & +! ranges%canst1, patchout_var, out_settings) +! CALL check_and_write(rpid%dleaf, 'dleaf', REAL(veg%dleaf, 4), & +! ranges%dleaf, patchout_var, out_settings) +! CALL check_and_write(rpid%ejmax, 'ejmax', REAL(veg%ejmax, 4), & +! ranges%ejmax, patchout_var, out_settings) +! CALL check_and_write(rpid%vcmax, 'vcmax', REAL(veg%vcmax, 4), & +! ranges%vcmax, patchout_var, out_settings) +! CALL check_and_write(rpid%frac4, 'frac4', REAL(veg%frac4, 4), & +! ranges%frac4, patchout_var, out_settings) +! CALL check_and_write(rpid%hc, 'hc', REAL(veg%hc, 4), & +! ranges%hc, patchout_var, out_settings) +! CALL check_and_write(rpid%rp20, 'rp20', REAL(veg%rp20, 4), & +! ranges%rp20, patchout_var, out_settings) +! CALL check_and_write(rpid%g0, 'g0', REAL(veg%g0, 4), & +! ranges%g0, patchout_var, out_settings) ! Ticket #56 +! CALL check_and_write(rpid%g1, 'g1', REAL(veg%g1, 4), & +! ranges%g1, patchout_var, out_settings) ! Ticket #56 +! CALL check_and_write(rpid%rpcoef, 'rpcoef', REAL(veg%rpcoef, 4), & +! ranges%rpcoef, patchout_var, out_settings) +! CALL check_and_write(rpid%shelrb, 'shelrb', REAL(veg%shelrb, 4), & +! ranges%shelrb, patchout_var, out_settings) +! CALL check_and_write(rpid%xfang, 'xfang', REAL(veg%xfang, 4), & +! ranges%xfang, patchout_var, out_settings) +! CALL check_and_write(rpid%wai, 'wai', REAL(veg%wai, 4), & +! ranges%wai, patchout_var, out_settings) +! CALL check_and_write(rpid%vegcf, 'vegcf', REAL(veg%vegcf, 4), & +! ranges%vegcf, patchout_var, out_settings) +! CALL check_and_write(rpid%extkn, 'extkn', REAL(veg%extkn, 4), & +! ranges%extkn, patchout_var, out_settings) +! CALL check_and_write(rpid%tminvj, 'tminvj', REAL(veg%tminvj, 4), & +! ranges%tminvj, patchout_var, out_settings) +! CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & +! ranges%tmaxvj, patchout_var, out_settings) +! CALL check_and_write(rpid%vbeta, 'vbeta', REAL(veg%vbeta, 4), & +! ranges%vbeta, patchout_var, out_settings) +! CALL check_and_write(rpid%xalbnir, 'xalbnir', & +! REAL(veg%xalbnir, 4), ranges%xalbnir, patchout_var, & +! out_settings) +! CALL check_and_write(rpid%tmaxvj, 'tmaxvj', REAL(veg%tmaxvj, 4), & +! ranges%tmaxvj, patchout_var, out_settings) +! ok = NF90_PUT_VAR(rpid%ratecp, REAL(bgc%ratecp, 4)) +! IF (ok /= NF90_NOERR) CALL nc_abort(ok, & +! 'Error writing ratecp parameter to ' & +! //TRIM(frst_out)//'(SUBROUTINE create_restart)') +! ok = NF90_PUT_VAR(rpid%ratecs, REAL(bgc%ratecs, 4)) +! IF (ok /= NF90_NOERR) CALL nc_abort(ok, & +! 'Error writing ratecs parameter to ' & +! //TRIM(frst_out)//'(SUBROUTINE create_restart)') +! out_settings%dimswitch = "integer" +! CALL check_and_write(rpid%meth, 'meth', REAL(veg%meth, 4), & +! ranges%meth, patchout_var, out_settings) +! out_settings%dimswitch = "real" +! CALL check_and_write(rpid%za_uv, 'za_uv', REAL(rough%za_uv, 4), & +! ranges%za, patchout_var, out_settings) +! CALL check_and_write(rpid%za_tq, 'za_tq', REAL(rough%za_tq, 4), & +! ranges%za, patchout_var, out_settings) out_settings%dimswitch = "r2" CALL check_and_write(dgdtgID, 'dgdtg', REAL(canopy%dgdtg, 4), & ranges%default_l, patchout_var, out_settings) @@ -3125,33 +3125,33 @@ SUBROUTINE create_restart(logn, dels, ktau, soil, veg, ssnow, CALL check_and_write(tradID, 'trad', & REAL(rad%trad, 4), ranges%RadT, patchout_var, out_settings) -!$ IF (cable_user%SOIL_STRUC == 'sli' .OR. cable_user%FWSOIL_SWITCH == 'Haverd2013') THEN -!$ CALL check_and_write(rpid%gamma, 'gamma', & -!$ REAL(veg%gamma, 4), ranges%default_s, patchout_var, out_settings) -!$ END IF -!$ +! IF (cable_user%SOIL_STRUC == 'sli' .OR. cable_user%FWSOIL_SWITCH == 'Haverd2013') THEN +! CALL check_and_write(rpid%gamma, 'gamma', & +! REAL(veg%gamma, 4), ranges%default_s, patchout_var, out_settings) +! END IF +! IF (cable_user%SOIL_STRUC == 'sli') THEN ! Write SLI parameters: out_settings%dimswitch = "integer" -!$ CALL check_and_write(rpid%nhorizons, 'nhorizons', & -!$ REAL(soil%nhorizons, 4), ranges%default_s, patchout_var, out_settings) +! CALL check_and_write(rpid%nhorizons, 'nhorizons', & +! REAL(soil%nhorizons, 4), ranges%default_s, patchout_var, out_settings) CALL check_and_write(nsnowID, 'nsnow', REAL(ssnow%nsnow, 4), & ranges%default_s, patchout_var, out_settings) out_settings%dimswitch = "soil" -!$ CALL check_and_write(rpid%ishorizon, 'ishorizon', & -!$ REAL(soil%ishorizon, 4), ranges%default_s, patchout_var, out_settings) +! CALL check_and_write(rpid%ishorizon, 'ishorizon', & +! REAL(soil%ishorizon, 4), ranges%default_s, patchout_var, out_settings) CALL check_and_write(SID, 'S', REAL(ssnow%S, 4), & ranges%S, patchout_var, out_settings) CALL check_and_write(TsoilID, 'Tsoil', REAL(ssnow%Tsoil, 4), & ranges%Tsoil, patchout_var, out_settings) out_settings%dimswitch = "real" -!$ CALL check_and_write(rpid%clitt, 'clitt', & -!$ REAL(veg%clitt, 4), ranges%default_s, patchout_var, out_settings) -!$ CALL check_and_write(rpid%ZR, 'ZR', & -!$ REAL(veg%ZR, 4), ranges%default_s, patchout_var, out_settings) -!$ CALL check_and_write(rpid%F10, 'F10', & -!$ REAL(veg%F10, 4), ranges%default_s, patchout_var, out_settings) +! CALL check_and_write(rpid%clitt, 'clitt', & +! REAL(veg%clitt, 4), ranges%default_s, patchout_var, out_settings) +! CALL check_and_write(rpid%ZR, 'ZR', & +! REAL(veg%ZR, 4), ranges%default_s, patchout_var, out_settings) +! CALL check_and_write(rpid%F10, 'F10', & +! REAL(veg%F10, 4), ranges%default_s, patchout_var, out_settings) CALL check_and_write(TsurfaceID, 'Tsurface', REAL(ssnow%Tsurface, 4), & ranges%default_s, patchout_var, out_settings) CALL check_and_write(h0ID, 'h0', REAL(ssnow%h0, 4), & diff --git a/src/offline/cable_plume_mip.F90 b/src/offline/cable_plume_mip.F90 index 31136010d..444f76c54 100644 --- a/src/offline/cable_plume_mip.F90 +++ b/src/offline/cable_plume_mip.F90 @@ -1049,14 +1049,14 @@ SUBROUTINE PLUME_MIP_GET_MET(PLUME, MET, CurYear, ktau, kend, islast ) -!$write(*,*) "met", met%precip(1), & -!$met%precip_sn (is:ie) , & -!$ met%fld (is:ie), & -!$ met%fsd (is:ie,1), & -!$ met%fsd (is:ie,2), & -!$ met%tk (is:ie) , & -!$ met%ua (is:ie) , & -!$ met%coszen (is:ie) +!write(*,*) "met", met%precip(1), & +!met%precip_sn (is:ie) , & +! met%fld (is:ie), & +! met%fsd (is:ie,1), & +! met%fsd (is:ie,2), & +! met%tk (is:ie) , & +! met%ua (is:ie) , & +! met%coszen (is:ie) !CLN IF ( ktau.EQ.1 ) & !CLN WRITE(*,*)"# qv Precip snow LWDin PhiLD rPhiLD PhiSD Temp Wind coszen" diff --git a/src/offline/cable_serial.F90 b/src/offline/cable_serial.F90 index 366aa58de..2faec5942 100644 --- a/src/offline/cable_serial.F90 +++ b/src/offline/cable_serial.F90 @@ -744,28 +744,28 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) ! vh ! commented code below detects Nans in evaporation flux and stops if there are any. -!$ do kk=1,mp -!$ if( canopy%fe(kk).NE.( canopy%fe(kk))) THEN -!$ write(*,*) 'fe nan', kk, ktau,met%qv(kk), met%precip(kk),met%precip_sn(kk), & -!$ met%fld(kk), met%fsd(kk,:), met%tk(kk), met%ua(kk), ssnow%potev(kk), met%pmb(kk), & -!$ canopy%ga(kk), ssnow%tgg(kk,:), canopy%fwsoil(kk) -!$ -!$ -!$ stop -!$ endif -!$ if ( casaflux%cnpp(kk).NE. casaflux%cnpp(kk)) then -!$ write(*,*) 'npp nan', kk, ktau, casaflux%cnpp(kk) -!$ stop -!$ -!$ endif -!$ -!$ -!$ !if (canopy%fwsoil(kk).eq.0.0) then -!$ ! write(*,*) 'zero fwsoil', ktau, canopy%fpn(kk) -!$ !endif -!$ -!$ -!$ enddo +! do kk=1,mp +! if( canopy%fe(kk).NE.( canopy%fe(kk))) THEN +! write(*,*) 'fe nan', kk, ktau,met%qv(kk), met%precip(kk),met%precip_sn(kk), & +! met%fld(kk), met%fsd(kk,:), met%tk(kk), met%ua(kk), ssnow%potev(kk), met%pmb(kk), & +! canopy%ga(kk), ssnow%tgg(kk,:), canopy%fwsoil(kk) +! +! +! stop +! endif +! if ( casaflux%cnpp(kk).NE. casaflux%cnpp(kk)) then +! write(*,*) 'npp nan', kk, ktau, casaflux%cnpp(kk) +! stop +! +! endif +! +! +! !if (canopy%fwsoil(kk).eq.0.0) then +! ! write(*,*) 'zero fwsoil', ktau, canopy%fpn(kk) +! !endif +! +! +! enddo IF( ktau == kend ) THEN nkend = nkend+1 @@ -795,9 +795,9 @@ SUBROUTINE serialdrv(NRRRR, dels, koffset, kend, GSWP_MID, PLUME, CRU, site) ! IF not 1st run through whole dataset: -!$ IF( MOD( ktau_tot, kend ) .EQ. 0 .AND. ktau_Tot .GT. kend .AND. & -!$ YYYY.EQ. CABLE_USER%YearEnd .OR. ( NRRRR .GT. 1 .AND. & -!$ RRRR.EQ. NRRRR) ) THEN +! IF( MOD( ktau_tot, kend ) .EQ. 0 .AND. ktau_Tot .GT. kend .AND. & +! YYYY.EQ. CABLE_USER%YearEnd .OR. ( NRRRR .GT. 1 .AND. & +! RRRR.EQ. NRRRR) ) THEN IF( MOD( ktau_tot, kend ) .EQ. 0 .AND. ktau_Tot .GT. kend .AND. & YYYY.EQ. CABLE_USER%YearEnd ) THEN diff --git a/src/offline/cable_weathergenerator.F90 b/src/offline/cable_weathergenerator.F90 index 835382f4d..1c46c072a 100644 --- a/src/offline/cable_weathergenerator.F90 +++ b/src/offline/cable_weathergenerator.F90 @@ -207,10 +207,10 @@ SUBROUTINE WGEN_DAILY_CONSTANTS( WG, np, YearDay ) ! TempMaxDay Tx ! TempMinDayNext Tp ! TempMaxDayPrev -!$write(71, "( 1000e16.6)") WG%DecRad -!$ write(72, "( 1000e16.6)") TAN(WG%DecRad) -!$ write(73, "( 1000e16.6)") TAN(WG%LatRad) -!$ write(74, "( 1000e16.6)") WG%DayLength +!write(71, "( 1000e16.6)") WG%DecRad +! write(72, "( 1000e16.6)") TAN(WG%DecRad) +! write(73, "( 1000e16.6)") TAN(WG%LatRad) +! write(74, "( 1000e16.6)") WG%DayLength WHERE ( WG%DayLength .LT. 0.01 ) ! Polar night WG%TimeSunrise = 9. ! Hn diff --git a/src/offline/gridinfo_CSIRO_1x1.nc b/src/offline/gridinfo_CSIRO_1x1.nc index 0a11086c324334fab6f68cde94b47b20398a14b4..4b4f4b87a91fc3256ad0eb760385e3b1855aab37 100644 GIT binary patch delta 3149 zcmWmEdsxp`0LSs?d@F@gq~uOTB#DrFR~1F2A3ubCm0O5Vx@`-6^+mI<&1kc^Om177 zxwM_RY~R{%TWxI1(6-EESd9=djom(H&AO1bVKf_n`{pB=;@?6gnFRv zs0ZqadZFH^59*8hq5jAdc_D8!01ZSwXb>8Ve9;i(hlWarP=DWJGVp=_`te$Y?=TdA zhNBTE5RF8mWQFhO5$Rgvj?pMcHtrZ>ey9a+8jHrs;7#NEHfhNj6J&D6#352E@t%Z& zQ3wh}VY0+K{E|sa&I?BoXfldKQ79TsK~qr-ibd1VbQC9(^WuGcrB)Vi3DTPC<52>d zffA8PHr3Cpf38{UW+5}0jpm@aC<)C&^U(s7EUk4G>sC!mNkOS74J|~A&|yDncsSgo=@dHlrXp7chJtP~fhj(q%aw3nQqv&1q9x6xg zqYuzAnG^Zp_1l`+?>IVvPNGxN>{qcgMXTIafj&YXBZ)qdmD^5-eW}?bol~rRiV$36@7s?|0`6DYS7o{8+0CBK;NS8(D$fT+9Y0#y_n@hLwHf0Yq)x&VV_G6JK?T}dD;ok zj@T0i(w=l69f_kb!aSYCl@#4WbrPTxaV9RLGwDKHNmt@V+(|d$LAsM3q$lY`dXqk+ zFX>166HnqryvYDzc&GzKH$@L99*8X!`;b9oF!3crh#whB{K+s9K!%eMBoN0@JW>Q7 z)ieD^2{4)jkuhW}8AryG31lLfM1qBp=^rAl&edbLga{By!brF^pl1kFZLb8Y~CQHatl1`S9cR~Aa9c0v^m&p}UM}8zfk)KIDxk`Q^*T}ErI%yy`$ZzB(xkYZ1-$^5B zB7cxOYXeqWri=tYhX1ZW`-$s^KA9+M~JPx6$sk-x|@@|^rl{vrR8|3pcV zqk@4@3=9;XbfY|5QEC$OtZGF8HpG_Lk#@wMIFR2L%sU(KP zl4)c*iBk-VHC}0KF`_FH6!QXOf0r4`no!-Ckse2v5*v!O47(evWP4uOUP1^PL`47iecNl zLOF0*KT?^YfR$tw$t0`E8nTvTk!-S#Z2Rm8oTp(kzQI2XD;z3+R@y_XO7KE3tOGxzpG&tLbX(_RBP2n`6++ZR<(1=hXwfUF}_aVgMei{bf3L`?Ny-a zpgO7`)k$@B_WA{PoS`u{)(5LD&W-h5M?KPUw~TJ8yVEVBN7LInj!Wt3#HIA|cPja| z3u(CEPDsTqn>y5M)NbV=-w@SXg{m;s$2sI1zAZ+RVi$+2zN(+Ho!G@ATKVbWm+l-9-$iR&zBocfswfq$Vw}qtM_zoUYtDsOHA=;)(Q1qutH!DE zYJ!^RI2Ypc*JyltLV}v464hiiMNL)H)O0mN%~VM$S*55{m8NDn=?Sw-ytGcr!r5w$ znycoi`D%e$s1~WkPRhdcQ#l&j)n|!%PAyf>s~6NV^`cs?Rw!F#s7$p|tx~Ji8mFsI zmOE7Il%{2=m(*IdPGzf?)hp^%wO+lZHmHqilX_jfp*E{G)fTnYDNWm!U7|HJ6Su3k z)Z1!@+Ns`gG81NDl4Jat@suJY9v z>V*1I6{wTyEA_QHrB17FRH6D-opJ6(ogI3AlgGeDEmn>X`%ZnY&Z+b2g8D)IsD4rx z)g|?_Gd}EcEk}=*_T;jbkn2iqtRarutRgQn%G_>W(T_cb&8+_X-NMPH^6R z^}q?vdw6<-{=BW&M+f$4d$7Xe^k{9{k9|DxsJ83slw=Lj`1+Gd)bHvK^`|OTPt;%P zsd}dVR{yAf)qh#_CmC0nC;N?WwuhHxL>VY+To12urle{m-|!U|Jj3nl*S33ea}Pv`|9(A&5X0iov77|n0JI@E|T=mX)#ZN0j$3D4BU zq#FH<=nn&6APj=RFa(AgH>pO1N$j8rg`p8f41?juEesuDN*?I^@xVwUq97V#U?jxC zD2Rj6Fb2lLI2aETU?Rjr0!)HLm<&^3DolgvFau^n5+p+kq(U0Zg4r+!=E6Lf4+~%+ zEP}<54ol!USPIV@_juq7rb3Ed?#Zn$7_kgqgypaTY{-C2SZUmoTUVLHJDTOcYPAt- zjO)KD%VZzZsUv+~GGZ;PgKT&iUV&F(J-h}RU?XgT*WnG=3~#~~*lOG(eYcrYy>*KW zdz%s4;VpO@cEC<}2X?``@E+`j_u&J`fe+y$*aIKKUgKui`^>bSy3gIbeManu1CR>` z;S+G+5FCaha1@Tgr|=oLkO#-%bI6A;-~@aL1#l9+GVa~HuT81`cV!pFo-*Pzd;^8> zEu1lKQS4dc=-WSgbIw^KzJu@K9Gr&>@B{n^Kfy(~1V6)NxB^$<8eE4PPz1lgP52dV z!EN{r?m#izg?q-`oO9nC(f3+*Ow|WQJcLK^7)s!G_yhigQg{M?!Bcn!f5SiUFZ^e+ zVyar&F_xVXx<)A!NfQnEFDqC)NK^3c5zizSv^0i_> zel@5LHJ~PVKrQfu+TaCspf1#d`p^IxLL+DlO`s_>gXZ83KHv*2pe3||*3bt0z#rN| zI|zXG5C|QhBLqPw=nTQo1-e2v=ng%gC-j04=nbI|27MqL`a(bG4+CHz41&Qh1cpKc z41?j88<0Q3y7f?>jaP1@HEM!(l50g-bHem?Ux|*gL^Q;}NQi||mU|^S&PvMGut7y} zmOH3uwB?hkqvXgjmYWEin$p!vvTJ@sI$MAQ2|R6qpLrU^>iznUG|; zr;C%V9p|)qYF>&ZQXvgy!EBfVb73CLhXt_Ea#QmbS!WJwen|RaOQc(FNcs}%*x~;H DU(IXJ diff --git a/src/offline/spincasacnp.F90 b/src/offline/spincasacnp.F90 index 72f0d3bfc..5711a5549 100755 --- a/src/offline/spincasacnp.F90 +++ b/src/offline/spincasacnp.F90 @@ -211,9 +211,9 @@ SUBROUTINE spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & ENDIF ! CALL_POP -!!$ WHERE(xkNlimiting .eq. 0) !Chris Lu 4/June/2012 -!!$ xkNlimiting = 0.001 -!!$ END WHERE +!! WHERE(xkNlimiting .eq. 0) !Chris Lu 4/June/2012 +!! xkNlimiting = 0.001 +!! END WHERE nptx=8173 ! Calculate average allocation fractions (-) for the plant pools @@ -328,8 +328,8 @@ SUBROUTINE spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & avg_nsoilmin,avg_psoillab,avg_psoilsorb,avg_psoilocc, & avg_af, avg_aw, avg_ar, avg_lf, avg_lw, avg_lr, avg_annual_cnpp) -!!$ call totcnppools(1,veg,casamet,casapool,bmcplant,bmnplant,bmpplant,bmclitter,bmnlitter,bmplitter, & -!!$ bmcsoil,bmnsoil,bmpsoil,bmnsoilmin,bmpsoillab,bmpsoilsorb,bmpsoilocc,bmarea) +!! call totcnppools(1,veg,casamet,casapool,bmcplant,bmnplant,bmpplant,bmclitter,bmnlitter,bmplitter, & +!! bmcsoil,bmnsoil,bmpsoil,bmnsoilmin,bmpsoillab,bmpsoilsorb,bmpsoilocc,bmarea) nloop1= MAX(1,mloop-3) @@ -420,9 +420,9 @@ SUBROUTINE spincasacnp( dels,kstart,kend,mloop,veg,soil,casabiome,casapool, & ENDDO ! end of nyear -!!$ if(nloop>=nloop1) & -!!$ call totcnppools(2+nloop-nloop1,veg,casamet,casapool,bmcplant,bmnplant,bmpplant,bmclitter,bmnlitter,bmplitter, & -!!$ bmcsoil,bmnsoil,bmpsoil,bmnsoilmin,bmpsoillab,bmpsoilsorb,bmpsoilocc,bmarea) +!! if(nloop>=nloop1) & +!! call totcnppools(2+nloop-nloop1,veg,casamet,casapool,bmcplant,bmnplant,bmpplant,bmclitter,bmnlitter,bmplitter, & +!! bmcsoil,bmnsoil,bmpsoil,bmnsoilmin,bmpsoillab,bmpsoilsorb,bmpsoilocc,bmarea) ENDDO ! end of nloop diff --git a/src/science/casa-cnp/casa_cnp.F90 b/src/science/casa-cnp/casa_cnp.F90 index 169a82f0d..981d291ca 100644 --- a/src/science/casa-cnp/casa_cnp.F90 +++ b/src/science/casa-cnp/casa_cnp.F90 @@ -395,19 +395,19 @@ SUBROUTINE casa_allocation(veg,soil,casabiome,casaflux,casapool,casamet,phen,LAL ! , leading to decline in mineral nitrogen availability and spikes in fracCalloc, ! causing spikes in tree mortality and lack of model convergence in productive ! regions where LAI is hitting LAImax. -!$ ! IF Prognostic LAI reached glaimax, no C is allocated to leaf -!$ ! Q.Zhang 17/03/2011 -!$ WHERE(casamet%glai(:)>=casabiome%glaimax(veg%iveg(:))) -!$ casaflux%fracCalloc(:,leaf) = 0.0 -!$ casaflux%fracCalloc(:,froot) = casaflux%fracCalloc(:,froot) & -!$ /(casaflux%fracCalloc(:,froot) & -!$ +casaflux%fracCalloc(:,wood)) -!$ WHERE (casamet%lnonwood==0) -!$ casaflux%fracCalloc(:,wood) = 1.0 -casaflux%fracCalloc(:,froot) -!$ ELSEWHERE -!$ casaflux%fracCalloc(:,wood) = 0.0 -!$ ENDWHERE -!$ ENDWHERE +! ! IF Prognostic LAI reached glaimax, no C is allocated to leaf +! ! Q.Zhang 17/03/2011 +! WHERE(casamet%glai(:)>=casabiome%glaimax(veg%iveg(:))) +! casaflux%fracCalloc(:,leaf) = 0.0 +! casaflux%fracCalloc(:,froot) = casaflux%fracCalloc(:,froot) & +! /(casaflux%fracCalloc(:,froot) & +! +casaflux%fracCalloc(:,wood)) +! WHERE (casamet%lnonwood==0) +! casaflux%fracCalloc(:,wood) = 1.0 -casaflux%fracCalloc(:,froot) +! ELSEWHERE +! casaflux%fracCalloc(:,wood) = 0.0 +! ENDWHERE +! ENDWHERE WHERE(casamet%glai(:)2) THEN diff --git a/src/science/casa-cnp/casa_inout.F90 b/src/science/casa-cnp/casa_inout.F90 index 57a0d3112..46f68959b 100644 --- a/src/science/casa-cnp/casa_inout.F90 +++ b/src/science/casa-cnp/casa_inout.F90 @@ -254,118 +254,118 @@ SUBROUTINE casa_init(casabiome,casamet,casaflux,casapool,casabal,veg,phen) WHERE(casamet%lnonwood==1) casapool%cplant(:,WOOD) = 0.0 WHERE(casamet%lnonwood==1) casapool%nplant(:,WOOD) = 0.0 WHERE(casamet%lnonwood==1) casapool%pplant(:,WOOD) = 0.0 -!$IF (initcasa==1) THEN -!$ INQUIRE( FILE=TRIM(casafile%cnpipool), EXIST=EXRST ) -!$! vh_js! -!$ IF ( EXRST ) THEN -!$ -!$ PRINT*, ' Reading cnppoolOutfile as input: ,',casafile%cnpipool -!$ -!$ OPEN(99,file=casafile%cnpipool) -!$ -!$ DO npt =1, mp -!$ SELECT CASE(icycle) -!$ CASE(1) -!$ ! vh_js ! -!$ IF (cable_user%CALL_POP) THEN -!$ -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt) , & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt) ,casapool%cplant(npt,:) , & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:), & -!$ casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt) -!$ -!$ -!$ ELSE -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt) , & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt) ,casapool%cplant(npt,:) , & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:) -!$ casaflux%frac_sapwood(:) = 1.0 -!$ casaflux%sapwood_area(:) = 0.0 -!$ ENDIF -!$ -!$ -!$ CASE(2) -!$! vh_js ! -!$ IF (cable_user%CALL_POP) THEN -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt), & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt),casapool%cplant(npt,:), & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:), & -!$ casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), & -!$ casapool%nplant(npt,:),casapool%nlitter(npt,:), & -!$ casapool%nsoil(npt,:),casapool%nsoilmin(npt) -!$ -!$ ELSE -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt), & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt),casapool%cplant(npt,:), & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:), & -!$ casapool%nplant(npt,:),casapool%nlitter(npt,:), & -!$ casapool%nsoil(npt,:),casapool%nsoilmin(npt) -!$ casaflux%frac_sapwood(:) = 1.0 -!$ casaflux%sapwood_area(:) = 0.0 -!$ -!$ ENDIF -!$ CASE(3) -!$! vh_js ! -!$ IF (cable_user%CALL_POP) THEN -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt), & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt),casapool%cplant(npt,:), & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:), & -!$ casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), & -!$ casapool%nplant(npt,:),casapool%nlitter(npt,:), & -!$ casapool%nsoil(npt,:),casapool%nsoilmin(npt), & -!$ casapool%pplant(npt,:),casapool%plitter(npt,:), & -!$ casapool%psoil(npt,:),casapool%psoillab(npt), & -!$ casapool%psoilsorb(npt),casapool%psoilocc(npt) -!$ ELSE -!$ READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & -!$ casamet%glai(npt),slaz,phen%phase(npt), & -!$ phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & -!$ casapool%clabile(npt),casapool%cplant(npt,:), & -!$ casapool%clitter(npt,:),casapool%csoil(npt,:), & -!$ casapool%nplant(npt,:),casapool%nlitter(npt,:), & -!$ casapool%nsoil(npt,:),casapool%nsoilmin(npt), & -!$ casapool%pplant(npt,:),casapool%plitter(npt,:), & -!$ casapool%psoil(npt,:),casapool%psoillab(npt), & -!$ casapool%psoilsorb(npt),casapool%psoilocc(npt) -!$ casaflux%frac_sapwood(:) = 1.0 -!$ casaflux%sapwood_area(:) = 0.0 -!$ -!$ -!$ ENDIF -!$ END SELECT -!$ IF (ABS(patch(npt)%longitude - lonz) > 0.9 .OR. & -!$ ABS(patch(npt)%latitude - latz) > 0.9) THEN -!$ PRINT *, 'patch(npt)%longitude, lonz:', patch(npt)%longitude, lonz -!$ PRINT *, 'patch(npt)%latitude, latz:', patch(npt)%latitude, latz -!$ PRINT *, 'npt = ', npt -!$ STOP -!$ ENDIF -!$ ENDDO -!$ CLOSE(99) -!$ -!$ -!$ ELSE -!$ ! vh_js ! -!$ WRITE(*,*)'No valid restart file for casa_init found.' -!$ WRITE(*,*)'Using input from readbiome.!' -!$ WRITE(*,*) 'initialising frac_sapwood=1 and sapwood_area = 0)' -!$ casaflux%frac_sapwood(:) = 1.0 -!$ casaflux%sapwood_area(:) = 0.0 -!$ -!$ -!$ ENDIF ! IF (EXRST) - -!$ENDIF +!IF (initcasa==1) THEN +! INQUIRE( FILE=TRIM(casafile%cnpipool), EXIST=EXRST ) +!! vh_js! +! IF ( EXRST ) THEN +! +! PRINT*, ' Reading cnppoolOutfile as input: ,',casafile%cnpipool +! +! OPEN(99,file=casafile%cnpipool) +! +! DO npt =1, mp +! SELECT CASE(icycle) +! CASE(1) +! ! vh_js ! +! IF (cable_user%CALL_POP) THEN +! +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt) , & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt) ,casapool%cplant(npt,:) , & +! casapool%clitter(npt,:),casapool%csoil(npt,:), & +! casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt) +! +! +! ELSE +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt) , & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt) ,casapool%cplant(npt,:) , & +! casapool%clitter(npt,:),casapool%csoil(npt,:) +! casaflux%frac_sapwood(:) = 1.0 +! casaflux%sapwood_area(:) = 0.0 +! ENDIF +! +! +! CASE(2) +!! vh_js ! +! IF (cable_user%CALL_POP) THEN +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt), & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt),casapool%cplant(npt,:), & +! casapool%clitter(npt,:),casapool%csoil(npt,:), & +! casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), & +! casapool%nplant(npt,:),casapool%nlitter(npt,:), & +! casapool%nsoil(npt,:),casapool%nsoilmin(npt) +! +! ELSE +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt), & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt),casapool%cplant(npt,:), & +! casapool%clitter(npt,:),casapool%csoil(npt,:), & +! casapool%nplant(npt,:),casapool%nlitter(npt,:), & +! casapool%nsoil(npt,:),casapool%nsoilmin(npt) +! casaflux%frac_sapwood(:) = 1.0 +! casaflux%sapwood_area(:) = 0.0 +! +! ENDIF +! CASE(3) +!! vh_js ! +! IF (cable_user%CALL_POP) THEN +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt), & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt),casapool%cplant(npt,:), & +! casapool%clitter(npt,:),casapool%csoil(npt,:), & +! casaflux%frac_sapwood(npt), casaflux%sapwood_area(npt), & +! casapool%nplant(npt,:),casapool%nlitter(npt,:), & +! casapool%nsoil(npt,:),casapool%nsoilmin(npt), & +! casapool%pplant(npt,:),casapool%plitter(npt,:), & +! casapool%psoil(npt,:),casapool%psoillab(npt), & +! casapool%psoilsorb(npt),casapool%psoilocc(npt) +! ELSE +! READ(99,*) nyearz,npz,ivtz,istz,isoz,latz,lonz,areacellz, & +! casamet%glai(npt),slaz,phen%phase(npt), & +! phen%doyphase(npt,3), phen%phen(npt), phen%aphen(npt), & +! casapool%clabile(npt),casapool%cplant(npt,:), & +! casapool%clitter(npt,:),casapool%csoil(npt,:), & +! casapool%nplant(npt,:),casapool%nlitter(npt,:), & +! casapool%nsoil(npt,:),casapool%nsoilmin(npt), & +! casapool%pplant(npt,:),casapool%plitter(npt,:), & +! casapool%psoil(npt,:),casapool%psoillab(npt), & +! casapool%psoilsorb(npt),casapool%psoilocc(npt) +! casaflux%frac_sapwood(:) = 1.0 +! casaflux%sapwood_area(:) = 0.0 +! +! +! ENDIF +! END SELECT +! IF (ABS(patch(npt)%longitude - lonz) > 0.9 .OR. & +! ABS(patch(npt)%latitude - latz) > 0.9) THEN +! PRINT *, 'patch(npt)%longitude, lonz:', patch(npt)%longitude, lonz +! PRINT *, 'patch(npt)%latitude, latz:', patch(npt)%latitude, latz +! PRINT *, 'npt = ', npt +! STOP +! ENDIF +! ENDDO +! CLOSE(99) +! +! +! ELSE +! ! vh_js ! +! WRITE(*,*)'No valid restart file for casa_init found.' +! WRITE(*,*)'Using input from readbiome.!' +! WRITE(*,*) 'initialising frac_sapwood=1 and sapwood_area = 0)' +! casaflux%frac_sapwood(:) = 1.0 +! casaflux%sapwood_area(:) = 0.0 +! +! +! ENDIF ! IF (EXRST) + +!ENDIF !92 format(5(i6,2x),5(f18.6,3x),2(i6,',',2x),',',2x,100(f18.6,3x)) 92 FORMAT(5(i6,',',2x),5(f18.6,',',2x),2(i6,',',2x),',',2x,100(f18.6,',',2x)) diff --git a/src/science/gw_hydro/cable_gw_hydro.F90 b/src/science/gw_hydro/cable_gw_hydro.F90 index 1d2105c41..65f7cd2b6 100644 --- a/src/science/gw_hydro/cable_gw_hydro.F90 +++ b/src/science/gw_hydro/cable_gw_hydro.F90 @@ -423,7 +423,7 @@ SUBROUTINE ovrlndflx (dels, ssnow, soil,veg, canopy,sli_call ) !--- glacier formation rnof5= 0. -!$ IF (sli_call .OR. cable_runtime%UM) THEN +! IF (sli_call .OR. cable_runtime%UM) THEN ! added by rk4417 to conform with MMY modifications IF (sli_call .OR. cable_runtime%UM .OR. cable_user%gw_model) THEN ! FEEDBACK (MMY asks: why cable_user%gw_model=True doesn't need to consider snow melting) --rk4417 nglacier = 0 @@ -989,7 +989,7 @@ SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) !> 6. set heat cap lower limit IF (cable_user%soil_thermal_fix) THEN -!$ soil%heat_cap_lower_limit(:,:) = 0.01 !never allow /0 ! FEEDBACK (MMY asks: I guess we should delete this line since someone changed it on purpose) --rk4417 +! soil%heat_cap_lower_limit(:,:) = 0.01 !never allow /0 ! FEEDBACK (MMY asks: I guess we should delete this line since someone changed it on purpose) --rk4417 soil%heat_cap_lower_limit(:,:) = 0._r_2 !allow /0 to show bugs ! FEEDBACK (MMY asks: I don't know how it shows bugs, can anyone check it???) --rk4417 ELSE print *, "MMY testing soil%css_vec(:,:) =",soil%css_vec(:,:), "soil%rhosoil_vec(:,:) = ", soil%rhosoil_vec(:,:) !MMY@18May2023 @@ -1007,37 +1007,37 @@ SUBROUTINE soil_snow_gw(dels, soil, ssnow, canopy, met, bal, veg) ! However, I don't know whether we should keep ssnow%snowd = max_glacier_snowd for soil%isoilm=9. ! Please check with Claire and Jhan if possible. -!$ ! MMY??? should we keep wb & wbice setting for soil%isoilm==9 (permanent ice) and snow covering region -!$ -!$ ! after discussion with BP ! block commented out by rk4417 as missing from MMY -!$ ! N.B. snmin should exceed sum of layer depths, i.e. .11 m ! need to discuss with MMY -!$ ssnow%wbtot = 0.0 -!$ ssnow%wb(:,:) = MIN( soil%ssat_vec(:,:), MAX ( ssnow%wb(:,:), 0.5*soil%swilt_vec(:,:) ) ) -!$ -!$ DO k = 1, ms -!$ -!$ WHERE( ssnow%tgg(:,k) <= CTFRZ .AND. ssnow%wbice(:,k) <= 0.001*ssnow%wb(:,k) ) & -!$ ssnow%wbice(:,k) = 0.5 * ssnow%wb(:,k) -!$ -!$ !WHERE( ssnow%tgg(:,k) < CTFRZ) & -!$ ! ssnow%wbice(:,k) = 0.8 * ssnow%wb(:,k) -!$ -!$ END DO -!$ WHERE ( soil%isoilm .EQ. 9)! .and. ssnow%snowd .le. 0.1*max_glacier_snowd) -!$ -!$ ! permanent ice: fix hard-wired number in next version -!$ ssnow%snowd = max_glacier_snowd -!$ ssnow%osnowd = max_glacier_snowd -!$ ssnow%tgg(:,1) = ssnow%tgg(:,1) - 1.0 -!$ -!$ END WHERE -!$ -!$ WHERE ( SPREAD(soil%isoilm,2,ms) .EQ. 9 ) -!$ -!$ ssnow%wb = 0.95 * soil%ssat_vec -!$ ssnow%wbice = 0.95 * ssnow%wb -!$ -!$ END WHERE +! ! MMY??? should we keep wb & wbice setting for soil%isoilm==9 (permanent ice) and snow covering region +! +! ! after discussion with BP ! block commented out by rk4417 as missing from MMY +! ! N.B. snmin should exceed sum of layer depths, i.e. .11 m ! need to discuss with MMY +! ssnow%wbtot = 0.0 +! ssnow%wb(:,:) = MIN( soil%ssat_vec(:,:), MAX ( ssnow%wb(:,:), 0.5*soil%swilt_vec(:,:) ) ) +! +! DO k = 1, ms +! +! WHERE( ssnow%tgg(:,k) <= CTFRZ .AND. ssnow%wbice(:,k) <= 0.001*ssnow%wb(:,k) ) & +! ssnow%wbice(:,k) = 0.5 * ssnow%wb(:,k) +! +! !WHERE( ssnow%tgg(:,k) < CTFRZ) & +! ! ssnow%wbice(:,k) = 0.8 * ssnow%wb(:,k) +! +! END DO +! WHERE ( soil%isoilm .EQ. 9)! .and. ssnow%snowd .le. 0.1*max_glacier_snowd) +! +! ! permanent ice: fix hard-wired number in next version +! ssnow%snowd = max_glacier_snowd +! ssnow%osnowd = max_glacier_snowd +! ssnow%tgg(:,1) = ssnow%tgg(:,1) - 1.0 +! +! END WHERE +! +! WHERE ( SPREAD(soil%isoilm,2,ms) .EQ. 9 ) +! +! ssnow%wb = 0.95 * soil%ssat_vec +! ssnow%wbice = 0.95 * ssnow%wb +! +! END WHERE ! END DELETE END IF @@ -1194,11 +1194,11 @@ SUBROUTINE calc_equilibrium_water_content(ssnow,soil) zi_smpc,tmp_const,voleq2 INTEGER :: k,i -!$ IF (gw_params%ssgw_ice_switch) THEN ! FEEDBACK (MMY asks: ask Claire or Anna what ssgw_ice_switch is for and whether to keep it) --rk4417 -!$ smp_cor = 8.0 -!$ ELSE -!$ smp_cor = 0.0 -!$ END IF +! IF (gw_params%ssgw_ice_switch) THEN ! FEEDBACK (MMY asks: ask Claire or Anna what ssgw_ice_switch is for and whether to keep it) --rk4417 +! smp_cor = 8.0 +! ELSE +! smp_cor = 0.0 +! END IF !make code cleaner define these here zimm(:,:) = 0._r_2 @@ -1207,23 +1207,23 @@ SUBROUTINE calc_equilibrium_water_content(ssnow,soil) zmm(:,k) = zimm(:,k-1) + 0.5_r_2*m2mm*soil%zse_vec(:,k) END DO -!$ IF (.NOT.gw_params%ssgw_ice_switch) THEN ! FEEDBACK (MMY asks: ask Claire or Anna what ssgw_ice_switch is for and whether to keep it) --rk4417 -!$ ice_correction(:,:) = 1._r_2 -!$ -!$ ELSE -!$ -!$ DO k=1,ms -!$ DO i=1,mp -!$ ice_correction(i,k) = 1._r_2 + smp_cor * ssnow%wbice(i,k) -!$ ice_correction(i,k) = ice_correction(i,k)**(2.0/soil%bch_vec(i,k)) -!$ END DO -!$ END DO -!$ DO i=1,mp -!$ ice_correction(i,ms+1) = 1._r_2 + smp_cor * ssnow%wbice(i,ms) -!$ ice_correction(i,ms+1) = ice_correction(i,ms+1)**(2.0/soil%GWbch_vec(i)) -!$ END DO -!$ -!$ END IF +! IF (.NOT.gw_params%ssgw_ice_switch) THEN ! FEEDBACK (MMY asks: ask Claire or Anna what ssgw_ice_switch is for and whether to keep it) --rk4417 +! ice_correction(:,:) = 1._r_2 +! +! ELSE +! +! DO k=1,ms +! DO i=1,mp +! ice_correction(i,k) = 1._r_2 + smp_cor * ssnow%wbice(i,k) +! ice_correction(i,k) = ice_correction(i,k)**(2.0/soil%bch_vec(i,k)) +! END DO +! END DO +! DO i=1,mp +! ice_correction(i,ms+1) = 1._r_2 + smp_cor * ssnow%wbice(i,ms) +! ice_correction(i,ms+1) = ice_correction(i,ms+1)**(2.0/soil%GWbch_vec(i)) +! END DO +! +! END IF do i=1,mp GWzimm(i) = zimm(i,ms)+m2mm*soil%GWdz(i) @@ -1578,15 +1578,15 @@ SUBROUTINE calc_soil_hydraulic_props(ssnow,soil,veg) kk = MIN(k+1,ms) DO i=1,mp IF (soil%isoilm(i) .EQ. 9) THEN -!$ hk_ice_factor(i,k) = 10.0**(-gw_params%ice_impedence) ! replaced as per MMY -- rk4417 ! MMY@23Apr2023 I don't know why the sign is changed, need to test its impact ... +! hk_ice_factor(i,k) = 10.0**(-gw_params%ice_impedence) ! replaced as per MMY -- rk4417 ! MMY@23Apr2023 I don't know why the sign is changed, need to test its impact ... !hk_ice_factor(i,k) = (1.0-soil%ssat_vec(i,k))**(gw_params%ice_impedence) hk_ice_factor(i,k) = 10.0**(gw_params%ice_impedence) ELSE -!$ hk_ice_factor(i,k) = 10.0**(-gw_params%ice_impedence* & ! replaced as per MMY -- rk4417 ! MMY@23Apr2023 keep the commented lines as a reminder for future check -!$ ( 0.5*(ssnow%wbice(i,k)/MAX(1.0e-8,ssnow%wb(i,k)) + & -!$ ssnow%wbice(i,kk)/MAX(1.0e-8,ssnow%wb(i,kk))) ) & -!$ ) +! hk_ice_factor(i,k) = 10.0**(-gw_params%ice_impedence* & ! replaced as per MMY -- rk4417 ! MMY@23Apr2023 keep the commented lines as a reminder for future check +! ( 0.5*(ssnow%wbice(i,k)/MAX(1.0e-8,ssnow%wb(i,k)) + & +! ssnow%wbice(i,kk)/MAX(1.0e-8,ssnow%wb(i,kk))) ) & +! ) !hk_ice_factor(i,k) = sqrt((1.0-ssnow%wbice(i,k))**(gw_params%ice_impedence) *& ! (1.0-ssnow%wbice(i,kk))**(gw_params%ice_impedence)) hk_ice_factor(i,k) = min(10.0**(gw_params%ice_impedence*ssnow%wbice(i,k)/(soil%ssat_vec(i,k)-soil%watr(i,k))) ,& ! MMY@23Apr2023 I don't know why the eq is changed, need to test its impact ... @@ -1922,7 +1922,7 @@ SUBROUTINE pore_space_relative_humidity(ssnow,soil,veg) ! Need a matching array of ones to use in Mark's call to the intrinsic ! sign func below ! mgk, 24/07/2018 -!$ REAL(r_2), DIMENSION(mp,ms) :: ones +! REAL(r_2), DIMENSION(mp,ms) :: ones REAL(r_2), DIMENSION(mp,ms) :: minus_ones ! rk4417 as per MMY INTEGER :: i diff --git a/src/science/misc/cable_climate.F90 b/src/science/misc/cable_climate.F90 index 5019a7330..fab0bec69 100644 --- a/src/science/misc/cable_climate.F90 +++ b/src/science/misc/cable_climate.F90 @@ -64,19 +64,19 @@ SUBROUTINE cable_climate(ktau,kstart,kend,ktauday,idoy,LOY,met,climate, canopy, REAL, PARAMETER:: SBoltz = 5.67e-8 ! Stefan-Boltzmann constant [W/m2/K4] climate%doy = idoy -!$! * Find irradiances, available energy, equilibrium latent heat flux -!$PPc = Gaero / ( Gaero + 4.0*SBoltz*((TempA+273.16)**3)/(RhoA*Capp) ) -!$ ! PPc = Ga/(Ga+Gr) [-] -!$EpsA = Epsif(TempA, Pmb) ! Epsi at TempA [-] -!$PhiSd = SolarMJ * 1.0e6 / (DayltFrac*SecDay) ! daylt down solar [W/m2] -!$PhiLd = 335.97 * (((TempA + 273.16) / 293.0)**6) ! daylt down thermal [W/m2] -!$ ! (Swinbank formula) -!$PhiAi = (1.0-Albedo)*PhiSd + Emis * & ! daylt iso-avail engy [W/m2] -!$ (PhiLd - SBoltz*((TempA + 273.16)**4)) ! (veg + soil) -!$PhiEq = PhiAi * (PPc*EpsA) / (PPc*EpsA + 1.0) ! equil ltnt heat flux [W/m2] -!$PhiEq = max(PhiEq, 1.0) ! PhiEq > +1 W/m2, so non-negative -!$ ! precipitation [m/day] -!$FWPT = CoeffPT * PhiEq * ((DayltFrac*SecDay) / (RhoW*Rlat)) +!! * Find irradiances, available energy, equilibrium latent heat flux +!PPc = Gaero / ( Gaero + 4.0*SBoltz*((TempA+273.16)**3)/(RhoA*Capp) ) +! ! PPc = Ga/(Ga+Gr) [-] +!EpsA = Epsif(TempA, Pmb) ! Epsi at TempA [-] +!PhiSd = SolarMJ * 1.0e6 / (DayltFrac*SecDay) ! daylt down solar [W/m2] +!PhiLd = 335.97 * (((TempA + 273.16) / 293.0)**6) ! daylt down thermal [W/m2] +! ! (Swinbank formula) +!PhiAi = (1.0-Albedo)*PhiSd + Emis * & ! daylt iso-avail engy [W/m2] +! (PhiLd - SBoltz*((TempA + 273.16)**4)) ! (veg + soil) +!PhiEq = PhiAi * (PPc*EpsA) / (PPc*EpsA + 1.0) ! equil ltnt heat flux [W/m2] +!PhiEq = max(PhiEq, 1.0) ! PhiEq > +1 W/m2, so non-negative +! ! precipitation [m/day] +!FWPT = CoeffPT * PhiEq * ((DayltFrac*SecDay) / (RhoW*Rlat)) ! accumulate annual evaporation and potential evaporation !ppc = 1.0 diff --git a/src/science/pop/POP.F90 b/src/science/pop/POP.F90 index 13d726122..457f5d0d2 100755 --- a/src/science/pop/POP.F90 +++ b/src/science/pop/POP.F90 @@ -264,34 +264,34 @@ SUBROUTINE InitPOP2D_Poisson(POP, mean_disturbance_interval, m) ENDDO ENDDO -!$ ! set first disturbance year for first dist interval class -!$ idist = 1 -!$ disturbance_interval = POP%pop_grid(g)%patch(1)%disturbance_interval(idist) -!$ DO c = 1,PATCH_REPS1 -!$ tmp2(c) = max(disturbance_interval*c/(PATCH_REPS1),1) -!$ ENDDO -!$ DO c = 1,PATCH_REPS1 -!$ i = 0 -!$ DO j = 1,PATCH_REPS2 -!$ ipatch = (j-1)*PATCH_REPS1 + c -!$ i = i+1 -!$ IF (i.gt.PATCH_REPS1) then -!$ i = 1 -!$ ENDIF -!$ do while ((tmp2(i+1).eq. tmp2(i)).and.(i.lt.PATCH_REPS1)) -!$ i = i+1 -!$ IF (i.gt.PATCH_REPS1) then -!$ i = 1 -!$ ENDIF -!$ -!$ ENDDO -!$ -!$ -!$ write(*,*) i, tmp2(i) -!$ POP%pop_grid(g)%patch(ipatch)%first_disturbance_year(idist) = tmp2(i) -!$ -!$ ENDDO -!$ ENDDO +! ! set first disturbance year for first dist interval class +! idist = 1 +! disturbance_interval = POP%pop_grid(g)%patch(1)%disturbance_interval(idist) +! DO c = 1,PATCH_REPS1 +! tmp2(c) = max(disturbance_interval*c/(PATCH_REPS1),1) +! ENDDO +! DO c = 1,PATCH_REPS1 +! i = 0 +! DO j = 1,PATCH_REPS2 +! ipatch = (j-1)*PATCH_REPS1 + c +! i = i+1 +! IF (i.gt.PATCH_REPS1) then +! i = 1 +! ENDIF +! do while ((tmp2(i+1).eq. tmp2(i)).and.(i.lt.PATCH_REPS1)) +! i = i+1 +! IF (i.gt.PATCH_REPS1) then +! i = 1 +! ENDIF +! +! ENDDO +! +! +! write(*,*) i, tmp2(i) +! POP%pop_grid(g)%patch(ipatch)%first_disturbance_year(idist) = tmp2(i) +! +! ENDDO +! ENDDO ! set first disturbance year for first 2nd interval class @@ -366,11 +366,11 @@ SUBROUTINE POPStep(POP, StemNPP, disturbance_interval, disturbance_intensity,LAI DO g=1,np it(g) = MAXVAL(pop%pop_grid(g)%patch(:)%age(1)) + 1 ENDDO -!$ DO idisturb = 1,NDISTURB -!$ CALL GetUniqueAgeFrequencies(POP, disturbance_interval, idisturb, it) -!$ ENDDO -!$ -!$ CALL GetPatchFrequencies(POP,it) +! DO idisturb = 1,NDISTURB +! CALL GetUniqueAgeFrequencies(POP, disturbance_interval, idisturb, it) +! ENDDO +! +! CALL GetPatchFrequencies(POP,it) IF (PRESENT(precip)) THEN IF(PRESENT(StemNPP_av)) THEN @@ -2360,13 +2360,13 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) POP%pop_grid(g)%sapwood_area = POP%pop_grid(g)%sapwood_area + & freq_age(iage)*sapwood_area_age(iage) -!$if (g==2) then -!$write(71, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage), growth_age(iage), stress_mort_age(iage), & -!$ crowd_mort_age(iage), tmp_min, tmp_max, real(age_max_growth), real(age_min_growth) -!$endif +!if (g==2) then +!write(71, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage), growth_age(iage), stress_mort_age(iage), & +! crowd_mort_age(iage), tmp_min, tmp_max, real(age_max_growth), real(age_min_growth) +!endif -!$if (g==2) write(72, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage) -!$if (g==1) write(71, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage) +!if (g==2) write(72, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage) +!if (g==1) write(71, "(2i4, 350e16.6)") it, iage, freq_age(iage), cmass_age(iage) POP%pop_grid(g)%stress_mortality = POP%pop_grid(g)%stress_mortality + & freq_age(iage)*stress_mort_age(iage) POP%pop_grid(g)%crowding_mortality = POP%pop_grid(g)%crowding_mortality + & @@ -2383,13 +2383,13 @@ SUBROUTINE INTERPOLATE_BIOMASS_1D(pop, disturbance_interval,it,g) pop%pop_grid(g)%biomass_age(iage) = cmass_age(iage) ENDDO -!$if (it.gt.400) then -!$ write(*,*) 'it, nage', it, nage -!$ write(591, "(350e16.6)") freq_age -!$ write(601,"(350e16.6)") cmass_age -!$ write(602,"(350e16.6)") stress_mort_age -!$ write(603,"(350e16.6)") real(age) -!$endif +!if (it.gt.400) then +! write(*,*) 'it, nage', it, nage +! write(591, "(350e16.6)") freq_age +! write(601,"(350e16.6)") cmass_age +! write(602,"(350e16.6)") stress_mort_age +! write(603,"(350e16.6)") real(age) +!endif DEALLOCATE(age) DEALLOCATE(freq_age) DEALLOCATE(cmass_age) diff --git a/src/science/pop/POPLUC.F90 b/src/science/pop/POPLUC.F90 index 579551967..a3977c89b 100644 --- a/src/science/pop/POPLUC.F90 +++ b/src/science/pop/POPLUC.F90 @@ -1493,16 +1493,16 @@ SUBROUTINE WRITE_LUC_OUTPUT_NC ( POPLUC, ctime, FINAL ) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) END DO ENDIF -!$ -!$ DO i = 1, SIZE(A3) -!$ STATUS = NF90_def_var(FILE_ID,TRIM(A3(i)) ,NF90_FLOAT,(/land_ID,hist_ID,t_ID/),VID3(i)) -!$ IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) -!$ END DO -!$ -!$ DO i = 1, SIZE(A3) -!$ STATUS = NF90_def_var(FILE_ID,TRIM(AI3(i)) ,NF90_INT,(/land_ID,hist_ID,t_ID/),VIDI3(i)) -!$ IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) -!$ END DO +! +! DO i = 1, SIZE(A3) +! STATUS = NF90_def_var(FILE_ID,TRIM(A3(i)) ,NF90_FLOAT,(/land_ID,hist_ID,t_ID/),VID3(i)) +! IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) +! END DO +! +! DO i = 1, SIZE(A3) +! STATUS = NF90_def_var(FILE_ID,TRIM(AI3(i)) ,NF90_INT,(/land_ID,hist_ID,t_ID/),VIDI3(i)) +! IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) +! END DO DO i = 1, SIZE(A4) STATUS = NF90_def_var(FILE_ID,TRIM(A4(i)) ,NF90_FLOAT,(/land_ID,nLU_ID,t_ID/),VID4(i)) diff --git a/src/science/pop/pop_io.F90 b/src/science/pop/pop_io.F90 index bbaa9818b..6896f9933 100755 --- a/src/science/pop/pop_io.F90 +++ b/src/science/pop/pop_io.F90 @@ -892,39 +892,39 @@ SUBROUTINE POP_IO ( POP, casamet, YEAR, ACTION, CF ) DEALLOCATE(R4) ! PUT 3D VARS ( mp,nlayer, t ) -!$ MPS:DO m = 1, mp -!$ -!$ -!$ PAT:DO p = 1, npatch2d -!$ -!$ -!$ STATUS = NF90_PUT_VAR(FILE_ID, VIDR7( 1), POP%pop_grid(m)%freq_ranked_age_unique(p,:),& -!$ start=(/ m, p, 1, CNT /), count=(/ 1, 1, NDISTURB, 1 /) ) -!$ IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) +! MPS:DO m = 1, mp +! +! +! PAT:DO p = 1, npatch2d +! +! +! STATUS = NF90_PUT_VAR(FILE_ID, VIDR7( 1), POP%pop_grid(m)%freq_ranked_age_unique(p,:),& +! start=(/ m, p, 1, CNT /), count=(/ 1, 1, NDISTURB, 1 /) ) +! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) ! LAYER STRUCTURE ! PUT 4D VARS ( mp,npatch2d, nlayer,t ) -!$ STATUS = NF90_PUT_VAR(FILE_ID, VIDI8( 1), POP%pop_grid(m)%patch(p)%layer(:)%ncohort,& -!$ start=(/ m, p, 1, CNT /), count=(/ 1, 1, nlayer, 1 /) ) -!$ IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) - -!$ -!$ -!$ -!$ LAY:DO l = 1, nlayer -!$ ! COHORT STRUCTURE -!$ ! PUT 5D VARS ( mp,npatch2d, nlayer,ncohort_max,t ) -!$ STATUS = NF90_PUT_VAR(FILE_ID, VIDI9( 1), POP%pop_grid(m)%patch(p)%layer(l)%cohort(:)%age,& -!$ start=(/ m, p, l, 1, CNT /), count=(/ 1, 1, 1, ncohort_max, 1 /) ) -!$ IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) -!$ STATUS = NF90_PUT_VAR(FILE_ID, VIDI9( 2), POP%pop_grid(m)%patch(p)%layer(l)%cohort(:)%id,& -!$ start=(/ m, p, l, 1, CNT /), count=(/ 1, 1, 1, ncohort_max, 1 /) ) -!$ IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) -!$ -!$ -!$ END DO LAY -!$ END DO PAT -!$ END DO MPS +! STATUS = NF90_PUT_VAR(FILE_ID, VIDI8( 1), POP%pop_grid(m)%patch(p)%layer(:)%ncohort,& +! start=(/ m, p, 1, CNT /), count=(/ 1, 1, nlayer, 1 /) ) +! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) + +! +! +! +! LAY:DO l = 1, nlayer +! ! COHORT STRUCTURE +! ! PUT 5D VARS ( mp,npatch2d, nlayer,ncohort_max,t ) +! STATUS = NF90_PUT_VAR(FILE_ID, VIDI9( 1), POP%pop_grid(m)%patch(p)%layer(l)%cohort(:)%age,& +! start=(/ m, p, l, 1, CNT /), count=(/ 1, 1, 1, ncohort_max, 1 /) ) +! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) +! STATUS = NF90_PUT_VAR(FILE_ID, VIDI9( 2), POP%pop_grid(m)%patch(p)%layer(l)%cohort(:)%id,& +! start=(/ m, p, l, 1, CNT /), count=(/ 1, 1, 1, ncohort_max, 1 /) ) +! IF(STATUS /= NF90_NoErr) CALL handle_err(STATUS) +! +! +! END DO LAY +! END DO PAT +! END DO MPS !============================================================================== ! READ POP VALUES AS RESTART VALUES diff --git a/src/science/pop/pop_mpi.F90 b/src/science/pop/pop_mpi.F90 index 5eec4dbb4..357318b56 100644 --- a/src/science/pop/pop_mpi.F90 +++ b/src/science/pop/pop_mpi.F90 @@ -913,11 +913,11 @@ SUBROUTINE create_pop_gridcell_type (gcell_t, comm) ! Scalar Integer -!$ bidx = bidx + 1 -!$ CALL MPI_Get_Address (tmp_grid(1)%npatch_active, a2, ierr) -!$ disp (bidx) = a2 - a1 -!$ blen (bidx) = 1 -!$ btype(bidx) = MPI_INTEGER +! bidx = bidx + 1 +! CALL MPI_Get_Address (tmp_grid(1)%npatch_active, a2, ierr) +! disp (bidx) = a2 - a1 +! blen (bidx) = 1 +! btype(bidx) = MPI_INTEGER bidx = bidx + 1 CALL MPI_Get_Address (tmp_grid(1)%LU, a2, ierr) diff --git a/src/science/sli/cable_sli_main.F90 b/src/science/sli/cable_sli_main.F90 index 041784548..5baae5c17 100644 --- a/src/science/sli/cable_sli_main.F90 +++ b/src/science/sli/cable_sli_main.F90 @@ -187,7 +187,7 @@ SUBROUTINE sli_main(ktau, dt, veg, soil, ssnow, met, canopy, air, rad, SEB_only) ENDIF ! If we want solutes: -!$ if (.not. allocated(bd)) allocate(bd(soil%nhorizons(k))) +! if (.not. allocated(bd)) allocate(bd(soil%nhorizons(k))) ! Litter parameters: IF (.NOT. ALLOCATED(plit)) THEN @@ -619,11 +619,11 @@ SUBROUTINE sli_main(ktau, dt, veg, soil, ssnow, met, canopy, air, rad, SEB_only) evap(k), evap_pot(k), infil(k), & drn(k), h0(k), Etrans(k)*dt, discharge(k), fws(k), (ip(k)-ipi(k)), fsat(k), runoff_sat(k), qb(k) -!$if (ktau==5) then -!$ -!$ write(*,*) win(k), (wp(k)-wpi(k)), deltah0(k),runoff(k), evap(k), drn(k), Etrans(k)*dt, canopy%fwsoil(k), canopy%fevc(k) -!$stop -!$endif +!if (ktau==5) then +! +! write(*,*) win(k), (wp(k)-wpi(k)), deltah0(k),runoff(k), evap(k), drn(k), Etrans(k)*dt, canopy%fwsoil(k), canopy%fevc(k) +!stop +!endif WRITE(334,"(100f15.6)") S(k,:), S(k,:)*par(k,:)%thre+par(k,:)%thr diff --git a/src/science/sli/cable_sli_solve.F90 b/src/science/sli/cable_sli_solve.F90 index b861b0229..ff5061c90 100644 --- a/src/science/sli/cable_sli_solve.F90 +++ b/src/science/sli/cable_sli_solve.F90 @@ -1062,24 +1062,24 @@ SUBROUTINE update_s_t( & END IF IF (.NOT. again(kk)) THEN -!$ if (h0(kk) nsteps_max) THEN WRITE(logn,*) "nsteps > nsteps_max ", irec, kk diff --git a/src/science/sli/cable_sli_utils.F90 b/src/science/sli/cable_sli_utils.F90 index 04a79ec8d..7f7d8a86f 100644 --- a/src/science/sli/cable_sli_utils.F90 +++ b/src/science/sli/cable_sli_utils.F90 @@ -512,16 +512,16 @@ SUBROUTINE SEB(n, par, vmet, vsnow, var, qprec, qprec_snow, dx, h0, Tsoil, & dEdTs= zero ! write(*,*) "Epot3", Tsurface, vmet%Ta, Epot, Hpot, vmet%rbh ENDIF -!$ elseif (abs(Tsurface - vmet%Ta).gt. 20) then -!$ Tsurface = min(vmet%Ta, 0.0) -!$ Epot = (esat(Tsurface)*0.018_r_2/thousand/8.314_r_2/(vmet%Ta+Tzero) - & ! m3 H2O (liq) m-3 (air) -!$ vmet%cva)*rhow*lambdas/vmet%rbw -!$ dEdTsoil = zero -!$ dGdTsoil = zero -!$ Hpot = rhocp*(Tsurface - vmet%Ta)/vmet%rbh -!$ Gpot = vmet%Rn-vmet%Rnsw - Hpot - Epot -!$ dEdTs= zero -!$ endif +! elseif (abs(Tsurface - vmet%Ta).gt. 20) then +! Tsurface = min(vmet%Ta, 0.0) +! Epot = (esat(Tsurface)*0.018_r_2/thousand/8.314_r_2/(vmet%Ta+Tzero) - & ! m3 H2O (liq) m-3 (air) +! vmet%cva)*rhow*lambdas/vmet%rbw +! dEdTsoil = zero +! dGdTsoil = zero +! Hpot = rhocp*(Tsurface - vmet%Ta)/vmet%rbh +! Gpot = vmet%Rn-vmet%Rnsw - Hpot - Epot +! dEdTs= zero +! endif qevap = Epot/(rhow*lambdas) qTb = -dEdTsoil/(thousand*lambdas) ENDIF @@ -1754,16 +1754,16 @@ SUBROUTINE getheatfluxes_1d(n, dx, dxL, qh, qhya, qhyb, qhTa, qhTb, var, vlit, T ! add advective terms IF (advection==1) THEN -!$ if (q(i) > zero) then -!$ w = (var(i)%kth/dx(i))/(var(i)%kth/dx(i)+var(i+1)%kth/dx(i+1)) -!$ else -!$ w = (var(i)%kth/dx(i))/(var(i)%kth/dx(i)+var(i+1)%kth/dx(i+1)) -!$ endif -!$ qadv(i) = rhow*cswat*q(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) -!$ qadvya(i) = rhow*cswat*qya(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) -!$ qadvyb(i) = rhow*cswat*qyb(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) -!$ qadvTa(i) = rhow*cswat*q(i)*w -!$ qadvTb(i) = rhow*cswat*q(i)*(one-w) +! if (q(i) > zero) then +! w = (var(i)%kth/dx(i))/(var(i)%kth/dx(i)+var(i+1)%kth/dx(i+1)) +! else +! w = (var(i)%kth/dx(i))/(var(i)%kth/dx(i)+var(i+1)%kth/dx(i+1)) +! endif +! qadv(i) = rhow*cswat*q(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) +! qadvya(i) = rhow*cswat*qya(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) +! qadvyb(i) = rhow*cswat*qyb(i)*(w*(T(i)+zero)+(one-w)*(T(i+1)+zero)) +! qadvTa(i) = rhow*cswat*q(i)*w +! qadvTb(i) = rhow*cswat*q(i)*(one-w) Tqw = MERGE(T(i), T(i+1), q(i)>zero) +zero dTqwdTa = MERGE(one, zero, (q(i)>zero)) diff --git a/src/shared/cable_LUC_EXPT.F90 b/src/shared/cable_LUC_EXPT.F90 index c4229b467..45a75be99 100644 --- a/src/shared/cable_LUC_EXPT.F90 +++ b/src/shared/cable_LUC_EXPT.F90 @@ -160,9 +160,9 @@ SUBROUTINE LUC_EXPT_INIT( LUC_EXPT) CALL HANDLE_ERR(STATUS, "Inquiring 'time'"//TRIM(LUC_EXPT%TransFile(i))) LUC_EXPT%nrec = tdimsize -!$ STATUS = NF90_GET_VAR( Luc_expt%f_id(i), timID, tmp, & -!$ start=(/1,1,1/) ) -!$ CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) +! STATUS = NF90_GET_VAR( Luc_expt%f_id(i), timID, tmp, & +! start=(/1,1,1/) ) +! CALL HANDLE_ERR(STATUS, "Reading from "//LUC_EXPT%TransFile(i) ) @@ -310,9 +310,9 @@ SUBROUTINE LUC_EXPT_INIT( LUC_EXPT) END WHERE -!$ WHERE (LUC_EXPT%ivegp == 14) -!$ LUC_EXPT%prim_only = .TRUE. -!$ END WHERE +! WHERE (LUC_EXPT%ivegp == 14) +! LUC_EXPT%prim_only = .TRUE. +! END WHERE END SUBROUTINE LUC_EXPT_INIT diff --git a/src/shared/casa_offline_inout.F90 b/src/shared/casa_offline_inout.F90 index 1fb70d1db..12e0af45e 100644 --- a/src/shared/casa_offline_inout.F90 +++ b/src/shared/casa_offline_inout.F90 @@ -369,7 +369,7 @@ SUBROUTINE READ_CASA_RESTART_NC ( casamet, casapool, casaflux,phen ) ! TIME STATUS = NF90_GET_ATT( FILE_ID, NF90_GLOBAL, "Valid restart date", RSTDATE ) IF (STATUS /= NF90_noerr) CALL handle_err(STATUS) -!!$ +!! WRITE(CYEAR, FMT="(I4)") CurYear CDATE = '01/01/'//CYEAR ! compare current year with restart year (only for non-site type met data)