diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 index 79c7b67b7..6a6df0672 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltImpConverter.F90 @@ -1,3 +1,6 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" + program SaltImpConverter use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius @@ -46,6 +49,7 @@ program SaltImpConverter character*256 :: longname character*256 :: units character*256 :: impNames(39) + character*256 :: Iam = "SaltImpConverter" INCLUDE 'netcdf.inc' !--------------------------------------------------------------------------- @@ -144,9 +148,9 @@ program SaltImpConverter do while (var_iter /= variables%end()) var_name => var_iter%key() if(var_name(1:6) == 'TSKINW') & - call MAPL_VarRead(InIntFmt,var_name,TW) + call MAPL_VarRead(InIntFmt,var_name,TW, __RC__) if(var_name(1:6) == 'SSKINW') & - call MAPL_VarRead(InIntFmt,var_name,SW) + call MAPL_VarRead(InIntFmt,var_name,SW, __RC__) call var_iter%next() enddo @@ -197,7 +201,7 @@ program SaltImpConverter ndims = var_dimensions%size() write(*,*)"Writing ",trim(var_name) if (ndims == 1) then - call MAPL_VarRead(InImpFmt,var_name,varIn) + call MAPL_VarRead(InImpFmt,var_name,varIn, __RC__) if(vname(1:8) == 'TS_FOUND') then varOut(:) = TW(:) else diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 index 9ef9609e1..e74175d91 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/SaltIntSplitter.F90 @@ -1,3 +1,5 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" program SaltIntSplitter use MAPL_ConstantsMod,only: MAPL_PI, MAPL_radius @@ -43,7 +45,8 @@ program SaltIntSplitter character*256 :: IceFileName integer :: dimSizes(3) integer :: filetype,nVars - + character*256 :: Iam = "SaltIntSplitter" + integer :: status !--------------------------------------------------------------------------- I = iargc() @@ -130,7 +133,7 @@ program SaltIntSplitter write(*,*)"Writing ",trim(var_name),ndims if (ndims == 1) then - call MAPL_VarRead(InFmt,var_name,varIn) + call MAPL_VarRead(InFmt,var_name,varIn, __RC__) varOut(:) = varIn(:) select case (var_name) case ('HSKINI','SSKINI','TSKINI') ! sea ice vars @@ -152,31 +155,31 @@ program SaltIntSplitter if (dataType == pFIO_REAL64) then ! R8 vars only from coupled if (var_name(1:2) == 'FR') then ! FR dim changes from 6 to 5 do j=2,dimSizes(2) - call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j) + call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j, __RC__) call MAPL_VarWrite(IceFmt,var_name,varInR8,offset1=j-1) enddo else do j=1,dimSizes(2) - call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j) + call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j, __RC__) call MAPL_VarWrite(IceFmt,var_name,varInR8,offset1=j) enddo endif else if (dimSizes(2) == 2) then ! AMIP - call MAPL_VarRead(InFmt,var_name,varIn,offset1=1) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=1, __RC__) call MAPL_VarWrite(IceFmt,var_name,varIn,offset1=1) - call MAPL_VarRead(InFmt,var_name,varIn,offset1=2) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=2, __RC__) call MAPL_VarWrite(WaterFmt,var_name,varIn,offset1=1) else if (var_name == 'TSKINI') then do j=1,dimSizes(2) - call MAPL_VarRead(InFmt,var_name,varIn,offset1=j) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=j, __RC__) call MAPL_VarWrite(IceFmt,var_name,varIn,offset1=j) enddo else - call MAPL_VarRead(InFmt,var_name,varIn,offset1=1) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=1, __RC__) call MAPL_VarWrite(WaterFmt,var_name,varIn,offset1=1) do j=2,dimSizes(2) - call MAPL_VarRead(InFmt,var_name,varIn,offset1=j) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=j, __RC__) call MAPL_VarWrite(IceFmt,var_name,varIn,offset1=j-1) enddo endif @@ -191,10 +194,10 @@ program SaltIntSplitter do k=1,dimSizes(3) do j=1,dimSizes(2) if (dataType == pFIO_REAL64) then - call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j,offset2=k) + call MAPL_VarRead(InFmt,var_name,varInR8,offset1=j,offset2=k, __RC__) call MAPL_VarWrite(IceFmt,var_name,varInR8,offset1=j,offset2=k) else - call MAPL_VarRead(InFmt,var_name,varIn,offset1=j,offset2=k) + call MAPL_VarRead(InFmt,var_name,varIn,offset1=j,offset2=k, __RC__) call MAPL_VarWrite(IceFmt,var_name,varIn,offset1=j,offset2=k) endif enddo diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 index 2ac8dc99d..c87d3953c 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_Catch.F90 @@ -1,3 +1,7 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" + +program Scale_Catch use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT @@ -121,7 +125,9 @@ end subroutine calc_soil_moist type(Netcdf4_fileformatter) :: formatter(3) type(Filemetadata) :: cfg(3) integer :: i, rc, filetype - + integer :: status + character(256) :: Iam = "Scale_Catch" + ! Usage ! ----- if (iargc() /= 6) then @@ -143,13 +149,13 @@ end subroutine calc_soil_moist ! ------------------------------- read(arg(3),'(a)') fname3 - call MAPL_NCIOGetFileType(fname1, filetype,rc=rc) + call MAPL_NCIOGetFileType(fname1, filetype, __RC__) if (filetype == 0) then - call formatter(1)%open(trim(fname1),pFIO_READ,rc=rc) - call formatter(2)%open(trim(fname2),pFIO_READ,rc=rc) - cfg(1)=formatter(1)%read(rc=rc) - cfg(2)=formatter(2)%read(rc=rc) + call formatter(1)%open(trim(fname1),pFIO_READ, __RC__) + call formatter(2)%open(trim(fname2),pFIO_READ, __RC__) + cfg(1)=formatter(1)%read(__RC__) + cfg(2)=formatter(2)%read(__RC__) else open(unit=10, file=trim(fname1), form='unformatted') open(unit=20, file=trim(fname2), form='unformatted') @@ -172,7 +178,7 @@ end subroutine calc_soil_moist if (filetype ==0) then - ntiles = cfg(1)%get_dimension('tile',rc=rc) + ntiles = cfg(1)%get_dimension('tile', __RC__) else @@ -200,8 +206,8 @@ end subroutine calc_soil_moist new = 2 if (filetype ==0) then - call readcatch_nc4 ( catch(old), formatter(old) ) - call readcatch_nc4 ( catch(new), formatter(new) ) + call readcatch_nc4 ( catch(old), formatter(old), __RC__ ) + call readcatch_nc4 ( catch(new), formatter(new), __RC__ ) else call readcatch ( 10,catch(old) ) call readcatch ( 20,catch(new) ) @@ -391,8 +397,8 @@ end subroutine calc_soil_moist ! ------------------ if (filetype ==0) then cfg(3)=cfg(2) - call formatter(3)%create(fname3,rc=rc) - call formatter(3)%write(cfg(3),rc=rc) + call formatter(3)%create(fname3, __RC__) + call formatter(3)%write(cfg(3), __RC__) call writecatch_nc4 ( catch(sca), formatter(3) ) else call writecatch ( 30,catch(sca) ) @@ -472,70 +478,73 @@ subroutine allocatch (ntiles,catch) return end subroutine allocatch - subroutine readcatch_nc4 (catch,formatter) + subroutine readcatch_nc4 (catch,formatter, rc) type(catch_rst) catch type(Netcdf4_fileformatter) :: formatter - - call MAPL_VarRead(formatter,"BF1",catch%bf1) - call MAPL_VarRead(formatter,"BF2",catch%bf2) - call MAPL_VarRead(formatter,"BF3",catch%bf3) - call MAPL_VarRead(formatter,"VGWMAX",catch%vgwmax) - call MAPL_VarRead(formatter,"CDCR1",catch%cdcr1) - call MAPL_VarRead(formatter,"CDCR2",catch%cdcr2) - call MAPL_VarRead(formatter,"PSIS",catch%psis) - call MAPL_VarRead(formatter,"BEE",catch%bee) - call MAPL_VarRead(formatter,"POROS",catch%poros) - call MAPL_VarRead(formatter,"WPWET",catch%wpwet) - call MAPL_VarRead(formatter,"COND",catch%cond) - call MAPL_VarRead(formatter,"GNU",catch%gnu) - call MAPL_VarRead(formatter,"ARS1",catch%ars1) - call MAPL_VarRead(formatter,"ARS2",catch%ars2) - call MAPL_VarRead(formatter,"ARS3",catch%ars3) - call MAPL_VarRead(formatter,"ARA1",catch%ara1) - call MAPL_VarRead(formatter,"ARA2",catch%ara2) - call MAPL_VarRead(formatter,"ARA3",catch%ara3) - call MAPL_VarRead(formatter,"ARA4",catch%ara4) - call MAPL_VarRead(formatter,"ARW1",catch%arw1) - call MAPL_VarRead(formatter,"ARW2",catch%arw2) - call MAPL_VarRead(formatter,"ARW3",catch%arw3) - call MAPL_VarRead(formatter,"ARW4",catch%arw4) - call MAPL_VarRead(formatter,"TSA1",catch%tsa1) - call MAPL_VarRead(formatter,"TSA2",catch%tsa2) - call MAPL_VarRead(formatter,"TSB1",catch%tsb1) - call MAPL_VarRead(formatter,"TSB2",catch%tsb2) - call MAPL_VarRead(formatter,"ATAU",catch%atau) - call MAPL_VarRead(formatter,"BTAU",catch%btau) - call MAPL_VarRead(formatter,"OLD_ITY",catch%ity) - call MAPL_VarRead(formatter,"TC",catch%tc) - call MAPL_VarRead(formatter,"QC",catch%qc) - call MAPL_VarRead(formatter,"OLD_ITY",catch%ity) - call MAPL_VarRead(formatter,"CAPAC",catch%capac) - call MAPL_VarRead(formatter,"CATDEF",catch%catdef) - call MAPL_VarRead(formatter,"RZEXC",catch%rzexc) - call MAPL_VarRead(formatter,"SRFEXC",catch%srfexc) - call MAPL_VarRead(formatter,"GHTCNT1",catch%ghtcnt1) - call MAPL_VarRead(formatter,"GHTCNT2",catch%ghtcnt2) - call MAPL_VarRead(formatter,"GHTCNT3",catch%ghtcnt3) - call MAPL_VarRead(formatter,"GHTCNT4",catch%ghtcnt4) - call MAPL_VarRead(formatter,"GHTCNT5",catch%ghtcnt5) - call MAPL_VarRead(formatter,"GHTCNT6",catch%ghtcnt6) - call MAPL_VarRead(formatter,"TSURF",catch%tsurf) - call MAPL_VarRead(formatter,"WESNN1",catch%wesnn1) - call MAPL_VarRead(formatter,"WESNN2",catch%wesnn2) - call MAPL_VarRead(formatter,"WESNN3",catch%wesnn3) - call MAPL_VarRead(formatter,"HTSNNN1",catch%htsnnn1) - call MAPL_VarRead(formatter,"HTSNNN2",catch%htsnnn2) - call MAPL_VarRead(formatter,"HTSNNN3",catch%htsnnn3) - call MAPL_VarRead(formatter,"SNDZN1",catch%sndzn1) - call MAPL_VarRead(formatter,"SNDZN2",catch%sndzn2) - call MAPL_VarRead(formatter,"SNDZN3",catch%sndzn3) - call MAPL_VarRead(formatter,"CH",catch%ch) - call MAPL_VarRead(formatter,"CM",catch%cm) - call MAPL_VarRead(formatter,"CQ",catch%cq) - call MAPL_VarRead(formatter,"FR",catch%fr) - call MAPL_VarRead(formatter,"WW",catch%ww) - - return + integer, optional, intent(out) :: rc + integer :: status + character(256) :: Iam = "readcatch_nc4" + + call MAPL_VarRead(formatter,"BF1",catch%bf1, __RC__) + call MAPL_VarRead(formatter,"BF2",catch%bf2, __RC__) + call MAPL_VarRead(formatter,"BF3",catch%bf3, __RC__) + call MAPL_VarRead(formatter,"VGWMAX",catch%vgwmax, __RC__) + call MAPL_VarRead(formatter,"CDCR1",catch%cdcr1, __RC__) + call MAPL_VarRead(formatter,"CDCR2",catch%cdcr2, __RC__) + call MAPL_VarRead(formatter,"PSIS",catch%psis, __RC__) + call MAPL_VarRead(formatter,"BEE",catch%bee, __RC__) + call MAPL_VarRead(formatter,"POROS",catch%poros, __RC__) + call MAPL_VarRead(formatter,"WPWET",catch%wpwet, __RC__) + call MAPL_VarRead(formatter,"COND",catch%cond, __RC__) + call MAPL_VarRead(formatter,"GNU",catch%gnu, __RC__) + call MAPL_VarRead(formatter,"ARS1",catch%ars1, __RC__) + call MAPL_VarRead(formatter,"ARS2",catch%ars2, __RC__) + call MAPL_VarRead(formatter,"ARS3",catch%ars3, __RC__) + call MAPL_VarRead(formatter,"ARA1",catch%ara1, __RC__) + call MAPL_VarRead(formatter,"ARA2",catch%ara2, __RC__) + call MAPL_VarRead(formatter,"ARA3",catch%ara3, __RC__) + call MAPL_VarRead(formatter,"ARA4",catch%ara4, __RC__) + call MAPL_VarRead(formatter,"ARW1",catch%arw1, __RC__) + call MAPL_VarRead(formatter,"ARW2",catch%arw2, __RC__) + call MAPL_VarRead(formatter,"ARW3",catch%arw3, __RC__) + call MAPL_VarRead(formatter,"ARW4",catch%arw4, __RC__) + call MAPL_VarRead(formatter,"TSA1",catch%tsa1, __RC__) + call MAPL_VarRead(formatter,"TSA2",catch%tsa2, __RC__) + call MAPL_VarRead(formatter,"TSB1",catch%tsb1, __RC__) + call MAPL_VarRead(formatter,"TSB2",catch%tsb2, __RC__) + call MAPL_VarRead(formatter,"ATAU",catch%atau, __RC__) + call MAPL_VarRead(formatter,"BTAU",catch%btau, __RC__) + call MAPL_VarRead(formatter,"OLD_ITY",catch%ity, __RC__) + call MAPL_VarRead(formatter,"TC",catch%tc, __RC__) + call MAPL_VarRead(formatter,"QC",catch%qc, __RC__) + call MAPL_VarRead(formatter,"OLD_ITY",catch%ity, __RC__) + call MAPL_VarRead(formatter,"CAPAC",catch%capac, __RC__) + call MAPL_VarRead(formatter,"CATDEF",catch%catdef, __RC__) + call MAPL_VarRead(formatter,"RZEXC",catch%rzexc, __RC__) + call MAPL_VarRead(formatter,"SRFEXC",catch%srfexc, __RC__) + call MAPL_VarRead(formatter,"GHTCNT1",catch%ghtcnt1, __RC__) + call MAPL_VarRead(formatter,"GHTCNT2",catch%ghtcnt2, __RC__) + call MAPL_VarRead(formatter,"GHTCNT3",catch%ghtcnt3, __RC__) + call MAPL_VarRead(formatter,"GHTCNT4",catch%ghtcnt4, __RC__) + call MAPL_VarRead(formatter,"GHTCNT5",catch%ghtcnt5, __RC__) + call MAPL_VarRead(formatter,"GHTCNT6",catch%ghtcnt6, __RC__) + call MAPL_VarRead(formatter,"TSURF",catch%tsurf, __RC__) + call MAPL_VarRead(formatter,"WESNN1",catch%wesnn1, __RC__) + call MAPL_VarRead(formatter,"WESNN2",catch%wesnn2, __RC__) + call MAPL_VarRead(formatter,"WESNN3",catch%wesnn3, __RC__) + call MAPL_VarRead(formatter,"HTSNNN1",catch%htsnnn1, __RC__) + call MAPL_VarRead(formatter,"HTSNNN2",catch%htsnnn2, __RC__) + call MAPL_VarRead(formatter,"HTSNNN3",catch%htsnnn3, __RC__) + call MAPL_VarRead(formatter,"SNDZN1",catch%sndzn1, __RC__) + call MAPL_VarRead(formatter,"SNDZN2",catch%sndzn2, __RC__) + call MAPL_VarRead(formatter,"SNDZN3",catch%sndzn3, __RC__) + call MAPL_VarRead(formatter,"CH",catch%ch, __RC__) + call MAPL_VarRead(formatter,"CM",catch%cm, __RC__) + call MAPL_VarRead(formatter,"CQ",catch%cq, __RC__) + call MAPL_VarRead(formatter,"FR",catch%fr, __RC__) + call MAPL_VarRead(formatter,"WW",catch%ww, __RC__) + + _RETURN(_SUCCESS) end subroutine readcatch_nc4 subroutine readcatch (unit,catch) @@ -734,7 +743,7 @@ subroutine writecatch (unit,catch) return end subroutine writecatch - end + end program subroutine calc_soil_moist( & ncat,vegcls,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & @@ -1257,4 +1266,3 @@ SUBROUTINE RZEQUIL ( & RETURN END SUBROUTINE RZEQUIL - diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 index ef80b1172..a45ede4ac 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/Scale_CatchCN.F90 @@ -1,3 +1,6 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" +program Scale_CatchCN use MAPL use lsm_routines, ONLY: catch_calc_tp, catch_calc_ght, DZGT USE CATCH_CONSTANTS, ONLY: N_GT => CATCH_N_GT @@ -146,7 +149,7 @@ end subroutine calc_soil_moist type(Netcdf4_fileformatter) :: formatter(3) type(Filemetadata) :: cfg(3) integer :: i, rc, filetype - + integer :: status ! Usage ! ----- if (iargc() /= 6) then @@ -236,8 +239,8 @@ end subroutine calc_soil_moist new = 2 if (filetype ==0) then - call readcatchcn_nc4 ( catch(old), formatter(old), cfg(old) ) - call readcatchcn_nc4 ( catch(new), formatter(new), cfg(new) ) + call readcatchcn_nc4 ( catch(old), formatter(old), cfg(old), __RC__ ) + call readcatchcn_nc4 ( catch(new), formatter(new), cfg(new), __RC__ ) ! else ! call readcatchcn ( 10,catch(old) ) ! call readcatchcn ( 20,catch(new) ) @@ -522,114 +525,117 @@ subroutine allocatch (ntiles,catch) return end subroutine allocatch - subroutine readcatchcn_nc4 (catch,formatter,cfg) - type(catch_rst) catch - type(Filemetadata) :: cfg - type(Netcdf4_Fileformatter) :: formatter - integer :: j, dim1,dim2 - type(Variable), pointer :: myVariable - character(len=:), pointer :: dname - - call MAPL_VarRead(formatter,"BF1",catch%bf1) - call MAPL_VarRead(formatter,"BF2",catch%bf2) - call MAPL_VarRead(formatter,"BF3",catch%bf3) - call MAPL_VarRead(formatter,"VGWMAX",catch%vgwmax) - call MAPL_VarRead(formatter,"CDCR1",catch%cdcr1) - call MAPL_VarRead(formatter,"CDCR2",catch%cdcr2) - call MAPL_VarRead(formatter,"PSIS",catch%psis) - call MAPL_VarRead(formatter,"BEE",catch%bee) - call MAPL_VarRead(formatter,"POROS",catch%poros) - call MAPL_VarRead(formatter,"WPWET",catch%wpwet) - call MAPL_VarRead(formatter,"COND",catch%cond) - call MAPL_VarRead(formatter,"GNU",catch%gnu) - call MAPL_VarRead(formatter,"ARS1",catch%ars1) - call MAPL_VarRead(formatter,"ARS2",catch%ars2) - call MAPL_VarRead(formatter,"ARS3",catch%ars3) - call MAPL_VarRead(formatter,"ARA1",catch%ara1) - call MAPL_VarRead(formatter,"ARA2",catch%ara2) - call MAPL_VarRead(formatter,"ARA3",catch%ara3) - call MAPL_VarRead(formatter,"ARA4",catch%ara4) - call MAPL_VarRead(formatter,"ARW1",catch%arw1) - call MAPL_VarRead(formatter,"ARW2",catch%arw2) - call MAPL_VarRead(formatter,"ARW3",catch%arw3) - call MAPL_VarRead(formatter,"ARW4",catch%arw4) - call MAPL_VarRead(formatter,"TSA1",catch%tsa1) - call MAPL_VarRead(formatter,"TSA2",catch%tsa2) - call MAPL_VarRead(formatter,"TSB1",catch%tsb1) - call MAPL_VarRead(formatter,"TSB2",catch%tsb2) - call MAPL_VarRead(formatter,"ATAU",catch%atau) - call MAPL_VarRead(formatter,"BTAU",catch%btau) - - myVariable => cfg%get_variable("ITY") - dname => myVariable%get_ith_dimension(2) - dim1 = cfg%get_dimension(dname) - do j=1,dim1 - call MAPL_VarRead(formatter,"ITY",catch%ity(:,j),offset1=j) - call MAPL_VarRead(formatter,"FVG",catch%fvg(:,j),offset1=j) - enddo - - call MAPL_VarRead(formatter,"TC",catch%tc) - call MAPL_VarRead(formatter,"QC",catch%qc) - call MAPL_VarRead(formatter,"TG",catch%tg) - call MAPL_VarRead(formatter,"CAPAC",catch%capac) - call MAPL_VarRead(formatter,"CATDEF",catch%catdef) - call MAPL_VarRead(formatter,"RZEXC",catch%rzexc) - call MAPL_VarRead(formatter,"SRFEXC",catch%srfexc) - call MAPL_VarRead(formatter,"GHTCNT1",catch%ghtcnt1) - call MAPL_VarRead(formatter,"GHTCNT2",catch%ghtcnt2) - call MAPL_VarRead(formatter,"GHTCNT3",catch%ghtcnt3) - call MAPL_VarRead(formatter,"GHTCNT4",catch%ghtcnt4) - call MAPL_VarRead(formatter,"GHTCNT5",catch%ghtcnt5) - call MAPL_VarRead(formatter,"GHTCNT6",catch%ghtcnt6) - call MAPL_VarRead(formatter,"TSURF",catch%tsurf) - call MAPL_VarRead(formatter,"WESNN1",catch%wesnn1) - call MAPL_VarRead(formatter,"WESNN2",catch%wesnn2) - call MAPL_VarRead(formatter,"WESNN3",catch%wesnn3) - call MAPL_VarRead(formatter,"HTSNNN1",catch%htsnnn1) - call MAPL_VarRead(formatter,"HTSNNN2",catch%htsnnn2) - call MAPL_VarRead(formatter,"HTSNNN3",catch%htsnnn3) - call MAPL_VarRead(formatter,"SNDZN1",catch%sndzn1) - call MAPL_VarRead(formatter,"SNDZN2",catch%sndzn2) - call MAPL_VarRead(formatter,"SNDZN3",catch%sndzn3) - call MAPL_VarRead(formatter,"CH",catch%ch) - call MAPL_VarRead(formatter,"CM",catch%cm) - call MAPL_VarRead(formatter,"CQ",catch%cq) - call MAPL_VarRead(formatter,"FR",catch%fr) - call MAPL_VarRead(formatter,"WW",catch%ww) - call MAPL_VarRead(formatter,"TILE_ID",catch%TILE_ID) - call MAPL_VarRead(formatter,"NDEP",catch%ndep) - call MAPL_VarRead(formatter,"CLI_T2M",catch%t2) - call MAPL_VarRead(formatter,"BGALBVR",catch%BGALBVR) - call MAPL_VarRead(formatter,"BGALBVF",catch%BGALBVF) - call MAPL_VarRead(formatter,"BGALBNR",catch%BGALBNR) - call MAPL_VarRead(formatter,"BGALBNF",catch%BGALBNF) - myVariable => cfg%get_variable("CNCOL") - dname => myVariable%get_ith_dimension(2) - dim1 = cfg%get_dimension(dname) - if(clm45) then - call MAPL_VarRead(formatter,"ABM", catch%ABM , rc = rc ) - call MAPL_VarRead(formatter,"FIELDCAP",catch%FIELDCAP) - call MAPL_VarRead(formatter,"HDM", catch%HDM ) - call MAPL_VarRead(formatter,"GDP", catch%GDP ) - call MAPL_VarRead(formatter,"PEATF", catch%PEATF ) - endif - do j=1,dim1 - call MAPL_VarRead(formatter,"CNCOL",catch%CNCOL(:,j),offset1=j) - enddo - ! The following three lines were added as a bug fix by smahanam on 5 Oct 2020 - ! (to be merged into the "develop" branch in late 2020): - ! The length of the 2nd dim of CNPFT differs from that of CNCOL. Prior to this fix, - ! CNPFT was not read in its entirety and some elements remained uninitialized (or zero), - ! resulting in bad values in the "regridded" (re-tiled) restart file. - ! This impacted re-tiled restarts for both CNCLM40 and CLCLM45. - ! - reichle, 23 Nov 2020 - myVariable => cfg%get_variable("CNPFT") - dname => myVariable%get_ith_dimension(2) - dim1 = cfg%get_dimension(dname) - do j=1,dim1 - call MAPL_VarRead(formatter,"CNPFT",catch%CNPFT(:,j),offset1=j) - enddo - return + subroutine readcatchcn_nc4 (catch,formatter,cfg, rc) + type(catch_rst) catch + type(Filemetadata) :: cfg + type(Netcdf4_Fileformatter) :: formatter + integer, optional, intent(out) :: rc + integer :: j, dim1,dim2 + type(Variable), pointer :: myVariable + character(len=:), pointer :: dname + character(256) :: Iam = "readcatchcn_nc4" + integer :: status + + call MAPL_VarRead(formatter,"BF1",catch%bf1, __RC__) + call MAPL_VarRead(formatter,"BF2",catch%bf2, __RC__) + call MAPL_VarRead(formatter,"BF3",catch%bf3, __RC__) + call MAPL_VarRead(formatter,"VGWMAX",catch%vgwmax, __RC__) + call MAPL_VarRead(formatter,"CDCR1",catch%cdcr1, __RC__) + call MAPL_VarRead(formatter,"CDCR2",catch%cdcr2, __RC__) + call MAPL_VarRead(formatter,"PSIS",catch%psis, __RC__) + call MAPL_VarRead(formatter,"BEE",catch%bee, __RC__) + call MAPL_VarRead(formatter,"POROS",catch%poros, __RC__) + call MAPL_VarRead(formatter,"WPWET",catch%wpwet, __RC__) + call MAPL_VarRead(formatter,"COND",catch%cond, __RC__) + call MAPL_VarRead(formatter,"GNU",catch%gnu, __RC__) + call MAPL_VarRead(formatter,"ARS1",catch%ars1, __RC__) + call MAPL_VarRead(formatter,"ARS2",catch%ars2, __RC__) + call MAPL_VarRead(formatter,"ARS3",catch%ars3, __RC__) + call MAPL_VarRead(formatter,"ARA1",catch%ara1, __RC__) + call MAPL_VarRead(formatter,"ARA2",catch%ara2, __RC__) + call MAPL_VarRead(formatter,"ARA3",catch%ara3, __RC__) + call MAPL_VarRead(formatter,"ARA4",catch%ara4, __RC__) + call MAPL_VarRead(formatter,"ARW1",catch%arw1, __RC__) + call MAPL_VarRead(formatter,"ARW2",catch%arw2, __RC__) + call MAPL_VarRead(formatter,"ARW3",catch%arw3, __RC__) + call MAPL_VarRead(formatter,"ARW4",catch%arw4, __RC__) + call MAPL_VarRead(formatter,"TSA1",catch%tsa1, __RC__) + call MAPL_VarRead(formatter,"TSA2",catch%tsa2, __RC__) + call MAPL_VarRead(formatter,"TSB1",catch%tsb1, __RC__) + call MAPL_VarRead(formatter,"TSB2",catch%tsb2, __RC__) + call MAPL_VarRead(formatter,"ATAU",catch%atau, __RC__) + call MAPL_VarRead(formatter,"BTAU",catch%btau, __RC__) + + myVariable => cfg%get_variable("ITY") + dname => myVariable%get_ith_dimension(2) + dim1 = cfg%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead(formatter,"ITY",catch%ity(:,j),offset1=j, __RC__) + call MAPL_VarRead(formatter,"FVG",catch%fvg(:,j),offset1=j, __RC__) + enddo + + call MAPL_VarRead(formatter,"TC",catch%tc, __RC__) + call MAPL_VarRead(formatter,"QC",catch%qc, __RC__) + call MAPL_VarRead(formatter,"TG",catch%tg, __RC__) + call MAPL_VarRead(formatter,"CAPAC",catch%capac, __RC__) + call MAPL_VarRead(formatter,"CATDEF",catch%catdef, __RC__) + call MAPL_VarRead(formatter,"RZEXC",catch%rzexc, __RC__) + call MAPL_VarRead(formatter,"SRFEXC",catch%srfexc, __RC__) + call MAPL_VarRead(formatter,"GHTCNT1",catch%ghtcnt1, __RC__) + call MAPL_VarRead(formatter,"GHTCNT2",catch%ghtcnt2, __RC__) + call MAPL_VarRead(formatter,"GHTCNT3",catch%ghtcnt3, __RC__) + call MAPL_VarRead(formatter,"GHTCNT4",catch%ghtcnt4, __RC__) + call MAPL_VarRead(formatter,"GHTCNT5",catch%ghtcnt5, __RC__) + call MAPL_VarRead(formatter,"GHTCNT6",catch%ghtcnt6, __RC__) + call MAPL_VarRead(formatter,"TSURF",catch%tsurf, __RC__) + call MAPL_VarRead(formatter,"WESNN1",catch%wesnn1, __RC__) + call MAPL_VarRead(formatter,"WESNN2",catch%wesnn2, __RC__) + call MAPL_VarRead(formatter,"WESNN3",catch%wesnn3, __RC__) + call MAPL_VarRead(formatter,"HTSNNN1",catch%htsnnn1, __RC__) + call MAPL_VarRead(formatter,"HTSNNN2",catch%htsnnn2, __RC__) + call MAPL_VarRead(formatter,"HTSNNN3",catch%htsnnn3, __RC__) + call MAPL_VarRead(formatter,"SNDZN1",catch%sndzn1, __RC__) + call MAPL_VarRead(formatter,"SNDZN2",catch%sndzn2, __RC__) + call MAPL_VarRead(formatter,"SNDZN3",catch%sndzn3, __RC__) + call MAPL_VarRead(formatter,"CH",catch%ch, __RC__) + call MAPL_VarRead(formatter,"CM",catch%cm, __RC__) + call MAPL_VarRead(formatter,"CQ",catch%cq, __RC__) + call MAPL_VarRead(formatter,"FR",catch%fr, __RC__) + call MAPL_VarRead(formatter,"WW",catch%ww, __RC__) + call MAPL_VarRead(formatter,"TILE_ID",catch%TILE_ID, __RC__) + call MAPL_VarRead(formatter,"NDEP",catch%ndep, __RC__) + call MAPL_VarRead(formatter,"CLI_T2M",catch%t2, __RC__) + call MAPL_VarRead(formatter,"BGALBVR",catch%BGALBVR, __RC__) + call MAPL_VarRead(formatter,"BGALBVF",catch%BGALBVF, __RC__) + call MAPL_VarRead(formatter,"BGALBNR",catch%BGALBNR, __RC__) + call MAPL_VarRead(formatter,"BGALBNF",catch%BGALBNF, __RC__) + myVariable => cfg%get_variable("CNCOL") + dname => myVariable%get_ith_dimension(2) + dim1 = cfg%get_dimension(dname) + if(clm45) then + call MAPL_VarRead(formatter,"ABM", catch%ABM, __RC__) + call MAPL_VarRead(formatter,"FIELDCAP",catch%FIELDCAP, __RC__) + call MAPL_VarRead(formatter,"HDM", catch%HDM , __RC__) + call MAPL_VarRead(formatter,"GDP", catch%GDP , __RC__) + call MAPL_VarRead(formatter,"PEATF", catch%PEATF , __RC__) + endif + do j=1,dim1 + call MAPL_VarRead(formatter,"CNCOL",catch%CNCOL(:,j),offset1=j, __RC__) + enddo + ! The following three lines were added as a bug fix by smahanam on 5 Oct 2020 + ! (to be merged into the "develop" branch in late 2020): + ! The length of the 2nd dim of CNPFT differs from that of CNCOL. Prior to this fix, + ! CNPFT was not read in its entirety and some elements remained uninitialized (or zero), + ! resulting in bad values in the "regridded" (re-tiled) restart file. + ! This impacted re-tiled restarts for both CNCLM40 and CLCLM45. + ! - reichle, 23 Nov 2020 + myVariable => cfg%get_variable("CNPFT") + dname => myVariable%get_ith_dimension(2) + dim1 = cfg%get_dimension(dname) + do j=1,dim1 + call MAPL_VarRead(formatter,"CNPFT",catch%CNPFT(:,j),offset1=j, __RC__) + enddo + _RETURN(_SUCCESS) end subroutine readcatchcn_nc4 subroutine readcatchcn (unit,catch) @@ -961,7 +967,7 @@ subroutine writecatchcn (unit,catch) return end subroutine writecatchcn - end + end program subroutine calc_soil_moist( & ncat,dzsf,vgwmax,cdcr1,cdcr2,wpwet,poros, & diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 index 8fd4d2e5b..424ffb6ae 100755 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchCNRestarts.F90 @@ -1,4 +1,5 @@ -#define VERIFY_(A) if(A /=0)then;print *,'ERROR code',A,'at',__LINE__;call exit(3);endif +#define I_AM_MAIN +#include "MAPL_Generic.h" program mk_CatchCNRestarts @@ -280,6 +281,7 @@ program mk_CatchCNRestarts type(Netcdf4_Fileformatter) :: InFmt,OutFmt type(FileMetadata) :: InCfg,OutCfg integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) + character(256) :: Iam = "mk_CatchCNRestarts" call init_MPI() call MPI_Info_create(infos, STATUS) ; VERIFY_(STATUS) @@ -326,12 +328,11 @@ program mk_CatchCNRestarts ! Reading restart time stamp and constructing daylength array ! ----------------------------------------------------------- - read (RestartTime (1: 4), '(i4)', IOSTAT = K) AGCM_YY ; VERIFY_(K) read (RestartTime (5: 6), '(i2)', IOSTAT = K) AGCM_MM ; VERIFY_(K) read (RestartTime (7: 8), '(i2)', IOSTAT = K) AGCM_DD ; VERIFY_(K) read (RestartTime (9:10), '(i2)', IOSTAT = K) AGCM_HR ; VERIFY_(K) - + MPI_PROC0 : if (root_proc) then ! Read Output/Input .til files @@ -343,14 +344,14 @@ program mk_CatchCNRestarts ! create output catchcn_internal_rst in nc4 format ! ------------------------------------------------ - call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_dummy',pFIO_READ,rc=rc) - InCfg=InFmt%read(rc=rc) - call MAPL_IOCountNonDimVars(InCfg,nvars,rc=rc) - call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/ntiles/),rc=rc) + call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_dummy',pFIO_READ, __RC__) + InCfg=InFmt%read( __RC__) + call MAPL_IOCountNonDimVars(InCfg,nvars, __RC__) + call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/ntiles/),__RC__) i = index(InRestart,'/',back=.true.) OutFileName = "OutData/"//trim(InRestart(i+1:)) - call OutFmt%create(OutFileName,rc=rc) - call OutFmt%write(OutCfg,rc=rc) + call OutFmt%create(OutFileName, __RC__) + call OutFmt%write(OutCfg, __RC__) i1= index(InRestart,'/',back=.true.) i = index(InRestart,'catchcn',back=.true.) @@ -396,14 +397,14 @@ program mk_CatchCNRestarts !OPT3 (Reading/writing BCs/hydrological variables) - if (root_proc) call read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) + if (root_proc) call read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart, __RC__) else ! What is the format of the InRestart file? ! ----------------------------------------- - call MAPL_NCIOGetFileType(InRestart, filetype,rc=rc) + call MAPL_NCIOGetFileType(InRestart, filetype, __RC__) if (filetype /= 0) then @@ -420,8 +421,8 @@ program mk_CatchCNRestarts ! check nVars: if nVars > 57 OPT1 (catchcn_internal_rst) ; else OPT2 (catch_internal_rst) ! --------------------------------------------------------------------------------------- - call InFmt%open(InRestart,pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) + call InFmt%open(InRestart,pFIO_READ, __RC__) + InCfg = InFmt%read(__RC__) call InFmt%close() call MAPL_IOCountNonDimVars(InCfg,nvars) @@ -525,7 +526,7 @@ program mk_CatchCNRestarts deallocate (loni,lati) - if (root_proc) call read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, ID, InRestart) + if (root_proc) call read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, ID, InRestart, __RC__) else @@ -599,7 +600,7 @@ program mk_CatchCNRestarts ! ***************************************************************************** - SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) + SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart, rc) ! This subroutine : ! 1) reads BCs from BCSDIR and hydrological varables from InRestart. @@ -613,6 +614,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) integer, intent (in) :: ntiles character (*), intent (in) :: InRestart type(Netcdf4_Fileformatter), intent (inout) :: OutFmt + integer, optional, intent(out) :: rc real, allocatable :: CLMC_pf1(:), CLMC_pf2(:), CLMC_sf1(:), CLMC_sf2(:) real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) @@ -627,13 +629,13 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) real, allocatable :: NDEP(:), BVISDR(:), BVISDF(:), BNIRDR(:), BNIRDF(:) real, allocatable :: T2(:), var1(:) integer, allocatable :: ity(:) - integer :: rc character*256 :: vname character*256 :: DataDir="OutData/clsm/" integer :: idum, i,j,n, ib, nv real :: rdum, zdep1, zdep2, zdep3, zmet, term1, term2, bare,fvg(4) logical :: file_exists type(Netcdf4_Fileformatter) :: InFmt,CatchCNFmt, CatchFmt + integer :: status allocate ( BF1(ntiles), BF2 (ntiles), BF3(ntiles) ) allocate (VGWMAX(ntiles), CDCR1(ntiles), CDCR2(ntiles) ) @@ -657,59 +659,59 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) if(file_exists) then print *,'FILE FORMAT FOR LAND BCS IS NC4' - call CatchFmt%open(trim(DataDir)//'/catch_params.nc4',pFIO_READ,rc=rc) - call CatchCNFmt%open(trim(DataDir)//'/catchcn_params.nc4',pFIO_READ,rc=rc) - call MAPL_VarRead ( CatchFmt ,'OLD_ITY', rity) - call MAPL_VarRead ( CatchFmt ,'ARA1', ARA1) - call MAPL_VarRead ( CatchFmt ,'ARA2', ARA2) - call MAPL_VarRead ( CatchFmt ,'ARA3', ARA3) - call MAPL_VarRead ( CatchFmt ,'ARA4', ARA4) - call MAPL_VarRead ( CatchFmt ,'ARS1', ARS1) - call MAPL_VarRead ( CatchFmt ,'ARS2', ARS2) - call MAPL_VarRead ( CatchFmt ,'ARS3', ARS3) - call MAPL_VarRead ( CatchFmt ,'ARW1', ARW1) - call MAPL_VarRead ( CatchFmt ,'ARW2', ARW2) - call MAPL_VarRead ( CatchFmt ,'ARW3', ARW3) - call MAPL_VarRead ( CatchFmt ,'ARW4', ARW4) + call CatchFmt%open(trim(DataDir)//'/catch_params.nc4',pFIO_READ, __RC__) + call CatchCNFmt%open(trim(DataDir)//'/catchcn_params.nc4',pFIO_READ, __RC__) + call MAPL_VarRead ( CatchFmt ,'OLD_ITY', rity, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA1', ARA1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA2', ARA2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA3', ARA3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA4', ARA4, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS1', ARS1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS2', ARS2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS3', ARS3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW1', ARW1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW2', ARW2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW3', ARW3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW4', ARW4, __RC__) if( SURFLAY.eq.20.0 ) then - call MAPL_VarRead ( CatchFmt ,'ATAU2', ATAU2) - call MAPL_VarRead ( CatchFmt ,'BTAU2', BTAU2) + call MAPL_VarRead ( CatchFmt ,'ATAU2', ATAU2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BTAU2', BTAU2, __RC__) endif if( SURFLAY.eq.50.0 ) then - call MAPL_VarRead ( CatchFmt ,'ATAU5', ATAU2) - call MAPL_VarRead ( CatchFmt ,'BTAU5', BTAU2) + call MAPL_VarRead ( CatchFmt ,'ATAU5', ATAU2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BTAU5', BTAU2, __RC__) endif - call MAPL_VarRead ( CatchFmt ,'PSIS', PSIS) - call MAPL_VarRead ( CatchFmt ,'BEE', BEE) - call MAPL_VarRead ( CatchFmt ,'BF1', BF1) - call MAPL_VarRead ( CatchFmt ,'BF2', BF2) - call MAPL_VarRead ( CatchFmt ,'BF3', BF3) - call MAPL_VarRead ( CatchFmt ,'TSA1', TSA1) - call MAPL_VarRead ( CatchFmt ,'TSA2', TSA2) - call MAPL_VarRead ( CatchFmt ,'TSB1', TSB1) - call MAPL_VarRead ( CatchFmt ,'TSB2', TSB2) - call MAPL_VarRead ( CatchFmt ,'COND', COND) - call MAPL_VarRead ( CatchFmt ,'GNU', GNU) - call MAPL_VarRead ( CatchFmt ,'WPWET', WPWET) - call MAPL_VarRead ( CatchFmt ,'DP2BR', DP2BR) - call MAPL_VarRead ( CatchFmt ,'POROS', POROS) - call MAPL_VarRead ( CatchCNFmt ,'BGALBNF', BNIRDF) - call MAPL_VarRead ( CatchCNFmt ,'BGALBNR', BNIRDR) - call MAPL_VarRead ( CatchCNFmt ,'BGALBVF', BVISDF) - call MAPL_VarRead ( CatchCNFmt ,'BGALBVR', BVISDR) - call MAPL_VarRead ( CatchCNFmt ,'NDEP', NDEP) - call MAPL_VarRead ( CatchCNFmt ,'T2_M', T2) - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt1,offset1=1) ! 30 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt2,offset1=2) ! 31 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st1,offset1=3) ! 32 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st2,offset1=4) ! 33 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf1,offset1=1) ! 34 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf2,offset1=2) ! 35 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf1,offset1=3) ! 36 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf2,offset1=4) ! 37 + call MAPL_VarRead ( CatchFmt ,'PSIS', PSIS, __RC__) + call MAPL_VarRead ( CatchFmt ,'BEE', BEE, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF1', BF1, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF2', BF2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF3', BF3, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSA1', TSA1, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSA2', TSA2, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSB1', TSB1, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSB2', TSB2, __RC__) + call MAPL_VarRead ( CatchFmt ,'COND', COND, __RC__) + call MAPL_VarRead ( CatchFmt ,'GNU', GNU, __RC__) + call MAPL_VarRead ( CatchFmt ,'WPWET', WPWET, __RC__) + call MAPL_VarRead ( CatchFmt ,'DP2BR', DP2BR, __RC__) + call MAPL_VarRead ( CatchFmt ,'POROS', POROS, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNF', BNIRDF, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNR', BNIRDR, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVF', BVISDF, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVR', BVISDR, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'NDEP', NDEP, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'T2_M', T2, __RC__) + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt1,offset1=1, __RC__) ! 30 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt2,offset1=2, __RC__) ! 31 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st1,offset1=3, __RC__) ! 32 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st2,offset1=4, __RC__) ! 33 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf1,offset1=1, __RC__) ! 34 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf2,offset1=2, __RC__) ! 35 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf1,offset1=3, __RC__) ! 36 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf2,offset1=4, __RC__) ! 37 call CatchFmt%close() call CatchCNFmt%close() @@ -867,7 +869,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) ! Now writing BCs (from BCSDIR) and regridded hydrological variables 1-72 ! ----------------------------------------------------------------------- - call InFmt%open(InRestart,pFIO_READ,rc=rc) + call InFmt%open(InRestart,pFIO_READ, __RC__) call MAPL_VarWrite(OutFmt,trim(CarbNames(1)),BF1) ! 1 call MAPL_VarWrite(OutFmt,trim(CarbNames(2)),BF2) ! 2 @@ -916,7 +918,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) if(n == 39) vname = 'QC' if(n == 40) vname = 'TG' do j = 1,4 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j) + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j, __RC__) call MAPL_VarWrite(OutFmt,vname,var1 ,offset1=j) ! 38-40 end do end do @@ -924,7 +926,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) ! CAPAC CATDEF RZEXC SRFEXC ... SNDZN3 do n=41,60 - call MAPL_VarRead ( InFmt,trim(CarbNames(n-6)),var1) + call MAPL_VarRead ( InFmt,trim(CarbNames(n-6)),var1, __RC__) call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1) ! 41-60 enddo @@ -937,7 +939,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) if(n == 65) var1 = 0.1 do j = 1,4 - call MAPL_VarRead ( InFmt,trim(CarbNames(n-6)),var1 ,offset1=j) + call MAPL_VarRead ( InFmt,trim(CarbNames(n-6)),var1 ,offset1=j, __RC__) call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1 ,offset1=j) ! 61-65 end do end do @@ -985,12 +987,12 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY, OutFmt, InRestart) deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1) deallocate (CLMC_sf2, CLMC_pt1, CLMC_pt2) deallocate (CLMC_st1,CLMC_st2) - + _RETURN(_SUCCESS) END SUBROUTINE read_bcs_data ! ***************************************************************************** - SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) + SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart, rc) implicit none @@ -1002,9 +1004,10 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) character(*), intent (in) :: InRestart type(Netcdf4_Fileformatter), intent (inout) :: OutFmt integer, dimension (NTILES), intent (in) :: IDX + integer, optional, intent(out) :: rc type(Netcdf4_Fileformatter) :: InFmt type(FileMetadata) :: InCfg - integer :: rc,n,i,j, ndims, nVars,dim1,dim2 + integer :: n,i,j, ndims, nVars,dim1,dim2 character(len=:), pointer :: vname real, allocatable :: var1 (:), var2 (:) integer, allocatable :: TILE_ID (:) @@ -1013,17 +1016,16 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) type(StringVariableMapIterator) :: var_iter type(StringVector), pointer :: var_dimensions character(len=:), pointer :: dname - + integer :: status - call InFmt%open(InRestart,pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) + call InFmt%open(InRestart,pFIO_READ, __RC__) + InCfg = InFmt%read(__RC__) allocate (var1 (1:NTILES_IN)) allocate (var2 (1:NTILES_IN)) allocate (TILE_ID (1:NTILES_IN)) - call MAPL_VarRead ( InFmt,'TILE_ID',var1) - + call MAPL_VarRead ( InFmt,'TILE_ID',var1, __RC__) do n = 1, NTILES_IN tile_id (NINT (var1(n))) = n end do @@ -1039,7 +1041,7 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) ndims = var_dimensions%size() if (ndims == 1) then - call MAPL_VarRead ( InFmt,vname,var1) + call MAPL_VarRead ( InFmt,vname,var1, __RC__) var2 = var1 (tile_id) call MAPL_VarWrite(OutFmt,vname,var2(idx)) @@ -1048,7 +1050,7 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) dname => var%get_ith_dimension(2) dim1=InCfg%get_dimension(dname) do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j) + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j, __RC__) var2 = var1 (tile_id) call MAPL_VarWrite(OutFmt,vname,var2(idx),offset1=j) enddo @@ -1061,7 +1063,7 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) dim2=InCfg%get_dimension(dname) do i=1,dim2 do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i) + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i, __RC__) var2 = var1 (tile_id) call MAPL_VarWrite(OutFmt,vname,var2(idx),offset1=j,offset2=i) enddo @@ -1075,172 +1077,11 @@ SUBROUTINE read_catchcn_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) deallocate (var1, var2, tile_id) call InFmt%close() call OutFmt%close() - + _RETURN(_SUCCESS) END SUBROUTINE read_catchcn_nc4 ! ***************************************************************************** - SUBROUTINE read_catch_nc4 (NTILES_IN, NTILES, OutFmt, IDX, InRestart) - - ! Reads catch_internal_rst nc4 file and writes out catchcn_internal_rst bin - ! with rigridded 1:29, 38: 39, and 41:65. The rest of the data records is filled - ! zeros. This subroutine is called when BCs data are not available. - ! The output catchcn_internal_rst file is binary. - - implicit none - - integer, intent (in) :: NTILES_IN, NTILES - type(Netcdf4_fileformatter), intent (inout) :: OutFmt - character(*), intent (in) :: InRestart - integer, dimension (NTILES), intent (in) :: IDX - real, allocatable :: var1 (:) - integer :: j, n, rc - type(Netcdf4_Fileformatter) :: InFmt - - call InFmt%open(InRestart,pFIO_READ,rc=rc) - - allocate (var1 (1:NTILES_IN)) - - do n = 1,29 - call MAPL_VarRead (InFmt,trim(CatNames(n)),var1) - call MAPL_VarWrite(OutFmt,trim(CarbNames(n)),var1(Idx)) - end do - - var1 = 0. - - do n = 30, 37 - call MAPL_VarWrite(OutFmt,trim(CarbNames(n)),var1(Idx)) - end do - - do n = 38,39 - do j=1,4 - if(n == 38) then - call MAPL_VarRead(InFmt,trim(CatNames(31)),var1,offset1=j) - call MAPL_VarWrite(OutFmt,trim(CarbNames(n -6)),var1(Idx),offset1=j) ! 38 - call MAPL_VarWrite(OutFmt,trim(CarbNames(40-6)),var1(Idx),offset1=j) ! 40 - endif - if(n == 39) then - call MAPL_VarRead(InFmt,trim(CatNames(32)) ,var1,offset1=j) - call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1(Idx),offset1=j) ! 39 - endif - enddo - end do - - do n = 41,60 - call MAPL_VarRead(InFmt,trim(CatNames(n-8)),var1) - call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1(Idx)) ! 41-60 - end do - - do n = 61,65 - do j=1,4 - call MAPL_VarRead(InFmt,trim(CatNames(n-8)),var1,offset1=j) - call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1(Idx),offset1=j) ! 61,65 - enddo - end do - - deallocate (var1) - - ! 66 : 1080 dont bother this file is merely an intermedeate file - - call InFmt%close() - call OutFmt%close() - - END SUBROUTINE read_catch_nc4 - - ! ***************************************************************************** - - SUBROUTINE read_catch_bin (NTILES_IN, NTILES, OutFmt, IDX) - - ! Reads catch_internal_rst bin file and writes out catchcn_internal_rst bin - ! with rigridded 1:29, 38: 39, and 41:65. The rest of the data records is filled - ! zeros. This subroutine is called when BCs data are not available. - ! The output catchcn_internal_rst file is nc4. - - implicit none - - integer, intent (in) :: NTILES_IN, NTILES - type(Netcdf4_Fileformatter), intent (inout) :: OutFmt - integer, dimension (NTILES), intent (in) :: IDX - real, allocatable :: var1 (:), vars(:,:), var2(:,:) - integer :: j, n - - allocate (var1 (1:NTILES_IN)) - allocate (vars (1:NTILES_IN,1:4)) - allocate (var2 (1:NTILES_IN,1:4)) - - do n=1,29 - read ( InUnit) var1 - call MAPL_VarWrite(OutFmt,trim(CarbNames(n)),var1(Idx)) - enddo - - read ( InUnit) var1 - var1 = 0. - - do n = 30, 37 - call MAPL_VarWrite(OutFmt,trim(CarbNames(n)),var1(Idx)) - end do - - read ( InUnit) vars - read ( InUnit) var2 - - do j = 1,4 - call MAPL_VarWrite(OutFmt,trim(CarbNames(38-6)),vars(Idx,j),offset1=j) ! 38 - call MAPL_VarWrite(OutFmt,trim(CarbNames(39-6)),var2(Idx,j),offset1=j) ! 39 - call MAPL_VarWrite(OutFmt,trim(CarbNames(40-6)),vars(Idx,j),offset1=j) ! 40 TG=TC - end do - - do n = 41,60 - read ( InUnit) var1 - call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var1(Idx)) - end do - - do n = 61, 65 - read ( InUnit) var2 - do j = 1,4 - call MAPL_VarWrite(OutFmt,trim(CarbNames(n-6)),var2(Idx,j),offset1=j) ! 61-65 - end do - end do - -! 66 : 1080 dont bother, this file is merely an intermedeate file - -! deallocate (var1) -! allocate (var1 (ntiles) -! do i = 1,ntiles -! var1(i) = real (i) -! end do -! -! call MAPL_VarWrite(OutFmt,CarbNames(66),var1) | 66 -! -! ! Below CNCOL and CNPFT are not necessary in this step. -! var1 = 0. -! -! do n = 67, 72 -! write(OutUnit) var1(IDX) -! end do - -! do n = 1,VAR_COL -! do j = 1,nzone -! write(OutUnit) var1(IDX) ! 73-192: CNCOL (n,nz*VAR_COL) -! end do -! end do - -! do n = 1,VAR_PFT -! do j = 1,nveg -! do i = 1,nzone -! write(OutUnit) var1(IDX) ! 193-1080: CNPFT (n,nz*nv*VAR_COL) -! end do -! end do -! end do - - deallocate (var1, var2, vars) - - close ( InUnit, status = 'keep') - call OutFmt%close() - - END SUBROUTINE read_catch_bin - - ! ***************************************************************************** - SUBROUTINE regrid_carbon_vars ( & NTILES,AGCM_YY,AGCM_MM,AGCM_DD,AGCM_HR, OutFileName, OutTileFile) @@ -1483,7 +1324,6 @@ SUBROUTINE regrid_carbon_vars ( & if(root_proc) then STATUS = NF_OPEN (trim(OutFileName),NF_WRITE,OUTID) ; VERIFY_(STATUS) - allocate (CLMC_pf1(NTILES)) allocate (CLMC_pf2(NTILES)) allocate (CLMC_sf1(NTILES)) @@ -2712,119 +2552,6 @@ SUBROUTINE put_land_vars (NTILES, id_glb, ld_reorder, OutFmt) END SUBROUTINE put_land_vars - - ! ***************************************************************************** - - SUBROUTINE reorder_LDASsa_rst (InRestart) - - implicit none - - character(*), intent (in) :: InRestart - integer :: i,n,j, iargc, rc, nVars, ndims,dim1,dim2,ntiles = ntiles_cn - type(Netcdf4_FileFormatter) :: InFmt, OutFmt - type(FileMetadata) :: InCfg, OutCfg - real, allocatable :: var1 (:), var2 (:) - integer, allocatable :: TILE_ID (:) - character*256 :: outfile - type(StringVariableMap), pointer :: variables - type(Variable), pointer :: var - type(StringVariableMapIterator) :: var_iter - type(StringVector), pointer :: var_dimensions - character(len=:), pointer :: vname,dname - - outfile = 'catchcn_internal_rst' - print *,InRestart - - call InFmt%open(InRestart,pFIO_READ,rc=rc) - InCfg = InFmt%read(rc=rc) - call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/ntiles/),rc=rc) - call OutFmt%create(outfile,rc=rc) - call OutFmt%write(OutCfg,rc=rc) - - - allocate (var1 (1:NTILES)) - allocate (var2 (1:NTILES)) - allocate (TILE_ID (1:NTILES)) - - call MAPL_VarRead ( InFmt,'TILE_ID',var1) - - do n = 1, NTILES - tile_id (NINT (var1(n))) = n - end do - - variables => InCfg%get_variables() - var_iter = variables%begin() - do while (var_iter /= variables%end()) - - vname => var_iter%key() - var => var_iter%value() - var_dimensions => var%get_dimensions() - - ndims = var_dimensions%size() - - if (ndims == 1) then - call MAPL_VarRead ( InFmt,vname,var1) - var2 = var1 (tile_id) - if(trim(vname) == 'SFMCM' ) var2 = 0. - if(trim(vname) == 'BFLOWM' ) var2 = 0. - if(trim(vname) == 'TOTWATM') var2 = 0. - if(trim(vname) == 'TAIRM' ) var2 = 0. - if(trim(vname) == 'TPM' ) var2 = 0. - if(trim(vname) == 'CNSUM' ) var2 = 0. - if(trim(vname) == 'SNDZM' ) var2 = 0. - if(trim(vname) == 'ASNOWM' ) var2 = 0. - if(trim(vname) == 'TSURF' ) var2 = 0. - - call MAPL_VarWrite(OutFmt,vname,var2) - - else if (ndims == 2) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j) - var2 = var1 (tile_id) - if(trim(vname) == 'TGWM' ) var2 = 0. - if(trim(vname) == 'RZMM' ) var2 = 0. - if(trim(vname) == 'WW' ) var2 = 0.1 - if(trim(vname) == 'FR' ) var2 = 0.25 - if(trim(vname) == 'CQ' ) var2 = 0.001 - if(trim(vname) == 'CN' ) var2 = 0.001 - if(trim(vname) == 'CM' ) var2 = 0.001 - if(trim(vname) == 'CH' ) var2 = 0.001 - call MAPL_VarWrite(OutFmt,vname,var2 ,offset1=j) - enddo - - else if (ndims == 3) then - - dname => var%get_ith_dimension(2) - dim1=InCfg%get_dimension(dname) - dname => var%get_ith_dimension(3) - dim2=InCfg%get_dimension(dname) - do i=1,dim2 - do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i) - var2 = var1 (tile_id) - if(trim(vname) == 'PSNSUNM' ) var2 = 0. - if(trim(vname) == 'PSNSHAM' ) var2 = 0. - call MAPL_VarWrite(OutFmt,vname,var2 ,offset1=j,offset2=i) - enddo - enddo - - end if - - call var_iter%next() - enddo - - deallocate (var1, var2, tile_id) - - call InFmt%close() - call OutFmt%close() - - STOP - - END SUBROUTINE reorder_LDASsa_rst - ! ***************************************************************************** subroutine init_MPI() diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 index ad32da84f..452000ce0 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_CatchRestarts.F90 @@ -1,3 +1,5 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" program mk_CatchRestarts ! $Id: @@ -32,6 +34,7 @@ program mk_CatchRestarts logical, allocatable, dimension(:) :: mask integer, allocatable, dimension (:) :: sub_tid real , allocatable, dimension (:) :: sub_lon, sub_lat + integer :: status call init_MPI() @@ -84,7 +87,7 @@ program mk_CatchRestarts endif if (havedata) then - if (root_proc) call read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES) + if (root_proc) call read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES, __RC__) else call MPI_BCAST (ntiles , 1, MPI_INTEGER, 0,MPI_COMM_WORLD, mpierr) @@ -229,7 +232,7 @@ program mk_CatchRestarts deallocate (loni,lati,lonn,latt, tid_in) call MPI_Barrier(MPI_COMM_WORLD, mpierr) - if (root_proc) call read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, id) + if (root_proc) call read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, id, __RC__) endif @@ -238,13 +241,14 @@ program mk_CatchRestarts contains - SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) + SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi, rc) implicit none real, intent (in) :: SURFLAY logical, intent (in) :: OutIsOld integer, intent (in) :: NTILES, NTILES_IN integer, pointer, dimension(:), optional, intent (in) :: idi + integer, optional, intent(out) :: rc logical :: havedata, NewLand character(len=256), parameter :: Names(29) = & (/'BF1 ','BF2 ','BF3 ','VGWMAX','CDCR1 ', & @@ -268,7 +272,7 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) real, allocatable :: var1(:),var2(:,:) character*256 :: vname character*256 :: OutFileName - integer :: rc, i, n, j,k,ncatch,idum + integer :: i, n, j,k,ncatch,idum logical,allocatable :: written(:) integer :: ndims,filetype integer :: dimSizes(3),nVars @@ -283,6 +287,8 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) character(len=:), pointer :: var_name,dname type(StringVector), pointer :: var_dimensions integer :: dim1, dim2 + character(256) :: Iam = "read_and_write_rst" + integer :: status print *, 'SURFLAY: ',SURFLAY @@ -291,18 +297,18 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) print *, 'havedata = ',havedata - call MAPL_NCIOGetFileType(InRestart, filetype,rc=rc) + call MAPL_NCIOGetFileType(InRestart, filetype,__RC__) if (filetype == 0) then - call InFmt%open(InRestart,pFIO_READ,rc=rc) - InCfg=InFmt%read(rc=rc) - call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/ntiles/),rc=rc) + call InFmt%open(InRestart,pFIO_READ,__RC__) + InCfg=InFmt%read(__RC__) + call MAPL_IOChangeRes(InCfg,OutCfg,(/'tile'/),(/ntiles/),__RC__) i = index(InRestart,'/',back=.true.) OutFileName = "OutData/"//trim(InRestart(i+1:)) - call OutFmt%create(OutFileName,rc=rc) - call OutFmt%write(OutCfg,rc=rc) - call MAPL_IOCountNonDimVars(OutCfg,nvars,rc=rc) + call OutFmt%create(OutFileName,__RC__) + call OutFmt%write(OutCfg,__RC__) + call MAPL_IOCountNonDimVars(OutCfg,nvars,__RC__) allocate(written(nvars)) written=.false. @@ -367,45 +373,45 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) if(file_exists) then print *,'FILE FORMAT FOR LAND BCS IS NC4' - call CatchFmt%open(trim(DataDir)//'/catch_params.nc4',pFIO_Read,rc=rc) - call MAPL_VarRead ( catchFmt ,'OLD_ITY', rity) - call MAPL_VarRead ( catchFmt ,'ARA1', ARA1) - call MAPL_VarRead ( catchFmt ,'ARA2', ARA2) - call MAPL_VarRead ( catchFmt ,'ARA3', ARA3) - call MAPL_VarRead ( catchFmt ,'ARA4', ARA4) - call MAPL_VarRead ( catchFmt ,'ARS1', ARS1) - call MAPL_VarRead ( catchFmt ,'ARS2', ARS2) - call MAPL_VarRead ( catchFmt ,'ARS3', ARS3) - call MAPL_VarRead ( catchFmt ,'ARW1', ARW1) - call MAPL_VarRead ( catchFmt ,'ARW2', ARW2) - call MAPL_VarRead ( catchFmt ,'ARW3', ARW3) - call MAPL_VarRead ( catchFmt ,'ARW4', ARW4) + call CatchFmt%open(trim(DataDir)//'/catch_params.nc4',pFIO_Read, __RC__) + call MAPL_VarRead ( catchFmt ,'OLD_ITY', rity, __RC__) + call MAPL_VarRead ( catchFmt ,'ARA1', ARA1, __RC__) + call MAPL_VarRead ( catchFmt ,'ARA2', ARA2, __RC__) + call MAPL_VarRead ( catchFmt ,'ARA3', ARA3, __RC__) + call MAPL_VarRead ( catchFmt ,'ARA4', ARA4, __RC__) + call MAPL_VarRead ( catchFmt ,'ARS1', ARS1, __RC__) + call MAPL_VarRead ( catchFmt ,'ARS2', ARS2, __RC__) + call MAPL_VarRead ( catchFmt ,'ARS3', ARS3, __RC__) + call MAPL_VarRead ( catchFmt ,'ARW1', ARW1, __RC__) + call MAPL_VarRead ( catchFmt ,'ARW2', ARW2, __RC__) + call MAPL_VarRead ( catchFmt ,'ARW3', ARW3, __RC__) + call MAPL_VarRead ( catchFmt ,'ARW4', ARW4, __RC__) if( SURFLAY.eq.20.0 ) then - call MAPL_VarRead ( catchFmt ,'ATAU2', ATAU2) - call MAPL_VarRead ( catchFmt ,'BTAU2', BTAU2) + call MAPL_VarRead ( catchFmt ,'ATAU2', ATAU2, __RC__) + call MAPL_VarRead ( catchFmt ,'BTAU2', BTAU2, __RC__) endif if( SURFLAY.eq.50.0 ) then - call MAPL_VarRead ( catchFmt ,'ATAU5', ATAU2) - call MAPL_VarRead ( catchFmt ,'BTAU5', BTAU2) + call MAPL_VarRead ( catchFmt ,'ATAU5', ATAU2, __RC__) + call MAPL_VarRead ( catchFmt ,'BTAU5', BTAU2, __RC__) endif - call MAPL_VarRead ( catchFmt ,'PSIS', PSIS) - call MAPL_VarRead ( catchFmt ,'BEE', BEE) - call MAPL_VarRead ( catchFmt ,'BF1', BF1) - call MAPL_VarRead ( catchFmt ,'BF2', BF2) - call MAPL_VarRead ( catchFmt ,'BF3', BF3) - call MAPL_VarRead ( catchFmt ,'TSA1', TSA1) - call MAPL_VarRead ( catchFmt ,'TSA2', TSA2) - call MAPL_VarRead ( catchFmt ,'TSB1', TSB1) - call MAPL_VarRead ( catchFmt ,'TSB2', TSB2) - call MAPL_VarRead ( catchFmt ,'COND', COND) - call MAPL_VarRead ( catchFmt ,'GNU', GNU) - call MAPL_VarRead ( catchFmt ,'WPWET', WPWET) - call MAPL_VarRead ( catchFmt ,'DP2BR', DP2BR) - call MAPL_VarRead ( catchFmt ,'POROS', POROS) - call catchFmt%close(rc=rc) + call MAPL_VarRead ( catchFmt ,'PSIS', PSIS, __RC__) + call MAPL_VarRead ( catchFmt ,'BEE', BEE, __RC__) + call MAPL_VarRead ( catchFmt ,'BF1', BF1, __RC__) + call MAPL_VarRead ( catchFmt ,'BF2', BF2, __RC__) + call MAPL_VarRead ( catchFmt ,'BF3', BF3, __RC__) + call MAPL_VarRead ( catchFmt ,'TSA1', TSA1, __RC__) + call MAPL_VarRead ( catchFmt ,'TSA2', TSA2, __RC__) + call MAPL_VarRead ( catchFmt ,'TSB1', TSB1, __RC__) + call MAPL_VarRead ( catchFmt ,'TSB2', TSB2, __RC__) + call MAPL_VarRead ( catchFmt ,'COND', COND, __RC__) + call MAPL_VarRead ( catchFmt ,'GNU', GNU, __RC__) + call MAPL_VarRead ( catchFmt ,'WPWET', WPWET, __RC__) + call MAPL_VarRead ( catchFmt ,'DP2BR', DP2BR, __RC__) + call MAPL_VarRead ( catchFmt ,'POROS', POROS, __RC__) + call catchFmt%close(__RC__) else open(unit=21, file=trim(DataDir)//"mosaic_veg_typs_fracs",status='old',form='formatted') @@ -490,38 +496,38 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) if (filetype == 0) then - call MAPL_VarRead(InFmt,names(1),BF1) - call MAPL_VarRead(InFmt,names(2),BF2) - call MAPL_VarRead(InFmt,names(3),BF3) - call MAPL_VarRead(InFmt,names(4),VGWMAX) - call MAPL_VarRead(InFmt,names(5),CDCR1) - call MAPL_VarRead(InFmt,names(6),CDCR2) - call MAPL_VarRead(InFmt,names(7),PSIS) - call MAPL_VarRead(InFmt,names(8),BEE) - call MAPL_VarRead(InFmt,names(9),POROS) - call MAPL_VarRead(InFmt,names(10),WPWET) + call MAPL_VarRead(InFmt,names(1),BF1, __RC__) + call MAPL_VarRead(InFmt,names(2),BF2, __RC__) + call MAPL_VarRead(InFmt,names(3),BF3, __RC__) + call MAPL_VarRead(InFmt,names(4),VGWMAX, __RC__) + call MAPL_VarRead(InFmt,names(5),CDCR1, __RC__) + call MAPL_VarRead(InFmt,names(6),CDCR2, __RC__) + call MAPL_VarRead(InFmt,names(7),PSIS, __RC__) + call MAPL_VarRead(InFmt,names(8),BEE, __RC__) + call MAPL_VarRead(InFmt,names(9),POROS, __RC__) + call MAPL_VarRead(InFmt,names(10),WPWET, __RC__) - call MAPL_VarRead(InFmt,names(11),COND) - call MAPL_VarRead(InFmt,names(12),GNU) - call MAPL_VarRead(InFmt,names(13),ARS1) - call MAPL_VarRead(InFmt,names(14),ARS2) - call MAPL_VarRead(InFmt,names(15),ARS3) - call MAPL_VarRead(InFmt,names(16),ARA1) - call MAPL_VarRead(InFmt,names(17),ARA2) - call MAPL_VarRead(InFmt,names(18),ARA3) - call MAPL_VarRead(InFmt,names(19),ARA4) - call MAPL_VarRead(InFmt,names(20),ARW1) + call MAPL_VarRead(InFmt,names(11),COND, __RC__) + call MAPL_VarRead(InFmt,names(12),GNU, __RC__) + call MAPL_VarRead(InFmt,names(13),ARS1, __RC__) + call MAPL_VarRead(InFmt,names(14),ARS2, __RC__) + call MAPL_VarRead(InFmt,names(15),ARS3, __RC__) + call MAPL_VarRead(InFmt,names(16),ARA1, __RC__) + call MAPL_VarRead(InFmt,names(17),ARA2, __RC__) + call MAPL_VarRead(InFmt,names(18),ARA3, __RC__) + call MAPL_VarRead(InFmt,names(19),ARA4, __RC__) + call MAPL_VarRead(InFmt,names(20),ARW1, __RC__) - call MAPL_VarRead(InFmt,names(21),ARW2) - call MAPL_VarRead(InFmt,names(22),ARW3) - call MAPL_VarRead(InFmt,names(23),ARW4) - call MAPL_VarRead(InFmt,names(24),TSA1) - call MAPL_VarRead(InFmt,names(25),TSA2) - call MAPL_VarRead(InFmt,names(26),TSB1) - call MAPL_VarRead(InFmt,names(27),TSB2) - call MAPL_VarRead(InFmt,names(28),ATAU2) - call MAPL_VarRead(InFmt,names(29),BTAU2) - call MAPL_VarRead(InFmt,'OLD_ITY',rITY) + call MAPL_VarRead(InFmt,names(21),ARW2, __RC__) + call MAPL_VarRead(InFmt,names(22),ARW3, __RC__) + call MAPL_VarRead(InFmt,names(23),ARW4, __RC__) + call MAPL_VarRead(InFmt,names(24),TSA1, __RC__) + call MAPL_VarRead(InFmt,names(25),TSA2, __RC__) + call MAPL_VarRead(InFmt,names(26),TSB1, __RC__) + call MAPL_VarRead(InFmt,names(27),TSB2, __RC__) + call MAPL_VarRead(InFmt,names(28),ATAU2, __RC__) + call MAPL_VarRead(InFmt,names(29),BTAU2, __RC__) + call MAPL_VarRead(InFmt,'OLD_ITY',rITY, __RC__) else @@ -634,14 +640,14 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) ndims = var_dimensions%size() if (ndims == 1) then - call MAPL_VarRead(InFmt,var_name,var1) + call MAPL_VarRead(InFmt,var_name,var1, __RC__) call MAPL_VarWrite(OutFmt,var_name,var1(idx)) else if (ndims == 2) then dname => myVariable%get_ith_dimension(2) dim1=InCfg%get_dimension(dname) do j=1,dim1 - call MAPL_VarRead(InFmt,var_name,var1,offset1=j) + call MAPL_VarRead(InFmt,var_name,var1,offset1=j, __RC__) call MAPL_VarWrite(OutFmt,var_name,var1(idx),offset1=j) enddo else if (ndims == 3) then @@ -652,7 +658,7 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) dim2=InCfg%get_dimension(dname) do k=1,dim2 do j=1,dim1 - call MAPL_VarRead(InFmt,var_name,var1,offset1=j,offset2=k) + call MAPL_VarRead(InFmt,var_name,var1,offset1=j,offset2=k, __RC__) call MAPL_VarWrite(OutFmt,var_name,var1(idx),offset1=j,offset2=k) enddo enddo @@ -746,7 +752,7 @@ SUBROUTINE read_and_write_rst (NTILES, SURFLAY, OutIsOld, NTILES_IN, idi) read (50) var2 write(40) ((var2(idx(i),j),i=1,ntiles),j=1,4) end if - + _RETURN(_SUCCESS) END SUBROUTINE read_and_write_rst ! ***************************************************************************** diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 index 60a980e9e..859076ceb 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_GEOSldasRestarts.F90 @@ -1,4 +1,5 @@ -#define VERIFY_(A) if(A /=0)then;print *,'ERROR code',A,'at',__LINE__;call exit(3);endif +#define I_AM_MAIN +#include "MAPL_Generic.h" PROGRAM mk_GEOSldasRestarts @@ -117,6 +118,7 @@ PROGRAM mk_GEOSldasRestarts logical :: second_visit integer :: zoom, k, n, infos character*100 :: InRestart + character(100) :: Iam = "mk_GEOSldasRestarts" VAR_COL = VAR_COL_CLM40 VAR_PFT = VAR_PFT_CLM40 @@ -210,7 +212,7 @@ PROGRAM mk_GEOSldasRestarts ! This call is to reorder a LDASsa restart file (RESTART: 1) - call reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MODEL, ENS, rstfile) + call reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MODEL, ENS, rstfile, __RC__) call MPI_Barrier(MPI_COMM_WORLD, STATUS) call MPI_FINALIZE(mpierr) @@ -292,7 +294,7 @@ PROGRAM mk_GEOSldasRestarts stop endif if (root_proc) then - call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData/clsm/','OutData/'//trim(MODEL)//'_internal_rst' ) + call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData/clsm/','OutData/'//trim(MODEL)//'_internal_rst', __RC__) endif call MPI_Barrier(MPI_COMM_WORLD, STATUS) @@ -334,7 +336,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) type(Netcdf4_FileFormatter) :: ldFmt type(FileMetadata) :: meta_data - + character(256) :: Iam = "regrid_from_xgrid" ! read NTILES from output BCs and tile_coord from GEOSldas/LDASsa input restarts open (10,file =trim(BCSDIR)//"clsm/catchment.def",status='old',form='formatted') @@ -369,10 +371,10 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD endif if (index(MODEL, 'catchcn') /=0) then - call ldFmt%open(trim(rst_file) , pFIO_READ,rc=rc) - meta_data = ldFmt%read(rc=rc) - call ldFmt%close(rc=rc) - if(meta_data%get_dimension('unknown_dim3',rc=rc) == 105) then + call ldFmt%open(trim(rst_file) , pFIO_READ,__RC__) + meta_data = ldFmt%read(__RC__) + call ldFmt%close(__RC__) + if(meta_data%get_dimension('unknown_dim3',rc=status) == 105) then clm45 = .true. VAR_COL = VAR_COL_CLM45 VAR_PFT = VAR_PFT_CLM45 @@ -533,7 +535,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD ! =========================================================== filetype = 0 - call MAPL_NCIOGetFileType(rst_file, filetype,rc=rc) + call MAPL_NCIOGetFileType(rst_file, filetype,__RC__) if(filetype == 0) then ! GEOSldas CATCH/CATCHCN or CATCHCN LDASsa call put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_file) @@ -549,7 +551,7 @@ SUBROUTINE regrid_from_xgrid (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MOD ! just delaying few seconds to allow the system to copy the file end do - call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData/clsm/','OutData/'//trim(model)//'_internal_rst' ) + call read_bcs_data (NTILES, SURFLAY, trim(MODEL),'OutData/clsm/','OutData/'//trim(model)//'_internal_rst', __RC__) endif @@ -708,12 +710,13 @@ END SUBROUTINE regrid_from_xgrid ! ***************************************************************************** - SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MODEL, ENS, rstfile) + SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MODEL, ENS, rstfile, rc) implicit none real, intent (in) :: SURFLAY character(*), intent (in) :: BCSDIR, YYYYMMDDHH, EXPNAME, EXPDIR, MODEL, ENS, rstfile + integer, optional, intent(out) :: rc character(256) :: tile_coord character(300) :: rst_file, out_rst_file type(Netcdf4_FileFormatter) :: InFmt,OutFmt, ldFmt @@ -729,7 +732,9 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI character(len=:), pointer :: vname,dname logical :: fexist, bin_out = .false. character(len=:), allocatable :: ftype - + character*256 :: Iam = "reorder_LDASsa_restarts" + integer :: status + if (trim(rstfile) == "NONE") then ftype = '' if(trim(MODEL) == 'catch') ftype='.bin' @@ -750,10 +755,10 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI out_rst_file = trim(model)//ENS//'_internal_rst.'//YYYYMMDDHH(1:8) if (index(model,'catchcn') /=0) then - call ldFmt%open(trim(rst_file) , pFIO_READ,rc=rc) - meta_data = ldFmt%read(rc=rc) - call ldFmt%close(rc=rc) - if(meta_data%get_dimension('unknown_dim3',rc=rc) == 105) then + call ldFmt%open(trim(rst_file) , pFIO_READ,__RC__) + meta_data = ldFmt%read(__RC__) + call ldFmt%close(__RC__) + if(meta_data%get_dimension('unknown_dim3',rc=status) == 105) then VAR_COL = VAR_COL_CLM45 VAR_PFT = VAR_PFT_CLM45 if ( .not. clm45) stop ' ERROR: Given clm45 restart, but the model is not clm45' @@ -784,22 +789,22 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI endif if(trim(MODEL) == 'catch') then - call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/Catch/catch_internal_rst' , pFIO_READ,rc=rc) + call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/Catch/catch_internal_rst' , pFIO_READ,__RC__) end if if(index(MODEL, 'catchcn') /=0) then if (clm45) then - call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_clm45',PFIO_READ, rc=rc) + call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_clm45',PFIO_READ, __RC__) else - call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_dummy' , pFIO_READ, rc=rc) + call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_dummy' , pFIO_READ, __RC__) endif end if - meta_data = InFmt%read(rc=rc) - call inFmt%close(rc=rc) + meta_data = InFmt%read(__RC__) + call inFmt%close(__RC__) - call meta_data%modify_dimension('tile',ntiles,rc=rc) + call meta_data%modify_dimension('tile',ntiles,__RC__) - call OutFmt%create(trim(out_rst_file),rc=rc) - call OutFmt%write(meta_data, rc=rc) + call OutFmt%create(trim(out_rst_file),__RC__) + call OutFmt%write(meta_data, __RC__) allocate (tile_id (1:ntiles)) @@ -1018,10 +1023,10 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI else ! CATCHCN - call InFmt%open(trim(rst_file),pFIO_READ,rc=rc) - meta_data = InFmt%read(rc=rc) + call InFmt%open(trim(rst_file),pFIO_READ,__RC__) + meta_data = InFmt%read(__RC__) - call MAPL_VarRead ( InFmt,'TILE_ID',var1) + call MAPL_VarRead ( InFmt,'TILE_ID',var1, __RC__) if(sum (nint(var1) - LDAS2BCS) /= 0) then print *, 'Tile order mismatch ', sum(var1)/ntiles, sum(LDAS2BCS)/ntiles stop @@ -1038,7 +1043,7 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI ndims = var_dimensions%size() if (ndims == 1) then - call MAPL_VarRead ( InFmt,vname,var1) + call MAPL_VarRead ( InFmt,vname,var1, __RC__) var2 = var1 (tile_id) do n = 1, NTILES var2(n) = var1(g2d(n)) @@ -1060,7 +1065,7 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI dname => var%get_ith_dimension(2) dim1=meta_data%get_dimension(dname) do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j) + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j, __RC__) var2 = var1 (tile_id) do n = 1, NTILES var2(n) = var1(g2d(n)) @@ -1084,7 +1089,7 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI dim2=meta_data%get_dimension(dname) do i=1,dim2 do j=1,dim1 - call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i) + call MAPL_VarRead ( InFmt,vname,var1 ,offset1=j,offset2=i, __RC__) var2 = var1 (tile_id) do n = 1, NTILES var2(n) = var1(g2d(n)) @@ -1104,15 +1109,16 @@ SUBROUTINE reorder_LDASsa_restarts (SURFLAY, BCSDIR, YYYYMMDDHH, EXPNAME, EXPDI deallocate (var1, var2, tile_id) endif - call read_bcs_data (ntiles, SURFLAY, trim(MODEL), trim(BCSDIR)//'/clsm/',trim(out_rst_file)) + call read_bcs_data (ntiles, SURFLAY, trim(MODEL), trim(BCSDIR)//'/clsm/',trim(out_rst_file), __RC__) if(bin_out) then - call InFmt%open(trim(out_rst_file),pFIO_READ,rc=rc) + call InFmt%open(trim(out_rst_file),pFIO_READ,__RC__) open(unit=30, file=trim(out_rst_file)//'.bin', form='unformatted') call write_bin (30, InFmt, NTILES) close(30) call InFmt%close() endif + _RETURN(_SUCCESS) END SUBROUTINE reorder_LDASsa_restarts @@ -1136,6 +1142,7 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) logical :: all_found + character(256) :: Iam="regrid_hyd_vars" if(index(MODEL, 'catchcn') /=0) ntiles_smap = ntiles_cn if(trim(MODEL) == 'catch' ) ntiles_smap = ntiles_cat @@ -1176,7 +1183,6 @@ SUBROUTINE regrid_hyd_vars (NTILES, model) allocate (ld_reorder(ntiles_smap)) call ReadTileFile_RealLatLon ('InData/OutTileFile', i, long, latg); VERIFY_(i-ntiles) - ! --------------------------------------------- ! Read exact lonc, latc from offline .til File ! --------------------------------------------- @@ -1283,7 +1289,7 @@ END SUBROUTINE regrid_hyd_vars ! ***************************************************************************** - SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) + SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart, rc) ! This subroutine : ! 1) reads BCs from BCSDIR and hydrological varables from InRestart. @@ -1296,6 +1302,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) real, intent (in) :: SURFLAY integer, intent (in) :: ntiles character(*), intent (in) :: MODEL, DataDir, InRestart + integer, optional, intent(out) :: rc real, allocatable :: CLMC_pf1(:), CLMC_pf2(:), CLMC_sf1(:), CLMC_sf2(:) real, allocatable :: CLMC_pt1(:), CLMC_pt2(:), CLMC_st1(:), CLMC_st2(:) real, allocatable :: CLMC45_pf1(:), CLMC45_pf2(:), CLMC45_sf1(:), CLMC45_sf2(:) @@ -1317,7 +1324,8 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) logical :: NEWLAND, isCatchCN logical :: file_exists type(NetCDF4_Fileformatter) :: CatchFmt,CatchCNFmt - + character*256 :: Iam = "read_bcs_data" + allocate ( BF1(ntiles), BF2 (ntiles), BF3(ntiles) ) allocate (VGWMAX(ntiles), CDCR1(ntiles), CDCR2(ntiles) ) allocate ( PSIS(ntiles), BEE(ntiles), POROS(ntiles) ) @@ -1348,62 +1356,62 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) if(file_exists) then print *,'FILE FORMAT FOR LAND BCS IS NC4' - call CatchFmt%Open(trim(DataDir)//'/catch_params.nc4', pFIO_READ, rc=rc) - call MAPL_VarRead ( CatchFmt ,'OLD_ITY', RITY) + call CatchFmt%Open(trim(DataDir)//'/catch_params.nc4', pFIO_READ, __RC__) + call MAPL_VarRead ( CatchFmt ,'OLD_ITY', RITY, __RC__) ITY = NINT (RITY) - call MAPL_VarRead ( CatchFmt ,'ARA1', ARA1) - call MAPL_VarRead ( CatchFmt ,'ARA2', ARA2) - call MAPL_VarRead ( CatchFmt ,'ARA3', ARA3) - call MAPL_VarRead ( CatchFmt ,'ARA4', ARA4) - call MAPL_VarRead ( CatchFmt ,'ARS1', ARS1) - call MAPL_VarRead ( CatchFmt ,'ARS2', ARS2) - call MAPL_VarRead ( CatchFmt ,'ARS3', ARS3) - call MAPL_VarRead ( CatchFmt ,'ARW1', ARW1) - call MAPL_VarRead ( CatchFmt ,'ARW2', ARW2) - call MAPL_VarRead ( CatchFmt ,'ARW3', ARW3) - call MAPL_VarRead ( CatchFmt ,'ARW4', ARW4) + call MAPL_VarRead ( CatchFmt ,'ARA1', ARA1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA2', ARA2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA3', ARA3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARA4', ARA4, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS1', ARS1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS2', ARS2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARS3', ARS3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW1', ARW1, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW2', ARW2, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW3', ARW3, __RC__) + call MAPL_VarRead ( CatchFmt ,'ARW4', ARW4, __RC__) if( SURFLAY.eq.20.0 ) then - call MAPL_VarRead ( CatchFmt ,'ATAU2', ATAU2) - call MAPL_VarRead ( CatchFmt ,'BTAU2', BTAU2) + call MAPL_VarRead ( CatchFmt ,'ATAU2', ATAU2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BTAU2', BTAU2, __RC__) endif if( SURFLAY.eq.50.0 ) then - call MAPL_VarRead ( CatchFmt ,'ATAU5', ATAU2) - call MAPL_VarRead ( CatchFmt ,'BTAU5', BTAU2) + call MAPL_VarRead ( CatchFmt ,'ATAU5', ATAU2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BTAU5', BTAU2, __RC__) endif - call MAPL_VarRead ( CatchFmt ,'PSIS', PSIS) - call MAPL_VarRead ( CatchFmt ,'BEE', BEE) - call MAPL_VarRead ( CatchFmt ,'BF1', BF1) - call MAPL_VarRead ( CatchFmt ,'BF2', BF2) - call MAPL_VarRead ( CatchFmt ,'BF3', BF3) - call MAPL_VarRead ( CatchFmt ,'TSA1', TSA1) - call MAPL_VarRead ( CatchFmt ,'TSA2', TSA2) - call MAPL_VarRead ( CatchFmt ,'TSB1', TSB1) - call MAPL_VarRead ( CatchFmt ,'TSB2', TSB2) - call MAPL_VarRead ( CatchFmt ,'COND', COND) - call MAPL_VarRead ( CatchFmt ,'GNU', GNU) - call MAPL_VarRead ( CatchFmt ,'WPWET', WPWET) - call MAPL_VarRead ( CatchFmt ,'DP2BR', DP2BR) - call MAPL_VarRead ( CatchFmt ,'POROS', POROS) + call MAPL_VarRead ( CatchFmt ,'PSIS', PSIS, __RC__) + call MAPL_VarRead ( CatchFmt ,'BEE', BEE, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF1', BF1, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF2', BF2, __RC__) + call MAPL_VarRead ( CatchFmt ,'BF3', BF3, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSA1', TSA1, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSA2', TSA2, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSB1', TSB1, __RC__) + call MAPL_VarRead ( CatchFmt ,'TSB2', TSB2, __RC__) + call MAPL_VarRead ( CatchFmt ,'COND', COND, __RC__) + call MAPL_VarRead ( CatchFmt ,'GNU', GNU, __RC__) + call MAPL_VarRead ( CatchFmt ,'WPWET', WPWET, __RC__) + call MAPL_VarRead ( CatchFmt ,'DP2BR', DP2BR, __RC__) + call MAPL_VarRead ( CatchFmt ,'POROS', POROS, __RC__) call CatchFmt%close() if(isCatchCN) then - call CatchCNFmt%Open(trim(DataDir)//'/catchcn_params.nc4', pFIO_READ, rc=rc) - call MAPL_VarRead ( CatchCNFmt ,'BGALBNF', BNIRDF) - call MAPL_VarRead ( CatchCNFmt ,'BGALBNR', BNIRDR) - call MAPL_VarRead ( CatchCNFmt ,'BGALBVF', BVISDF) - call MAPL_VarRead ( CatchCNFmt ,'BGALBVR', BVISDR) - call MAPL_VarRead ( CatchCNFmt ,'NDEP', NDEP) - call MAPL_VarRead ( CatchCNFmt ,'T2_M', T2) - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt1,offset1=1) ! 30 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt2,offset1=2) ! 31 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st1,offset1=3) ! 32 - call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st2,offset1=4) ! 33 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf1,offset1=1) ! 34 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf2,offset1=2) ! 35 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf1,offset1=3) ! 36 - call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf2,offset1=4) ! 37 + call CatchCNFmt%Open(trim(DataDir)//'/catchcn_params.nc4', pFIO_READ, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNF', BNIRDF, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBNR', BNIRDR, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVF', BVISDF, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'BGALBVR', BVISDR, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'NDEP', NDEP, __RC__) + call MAPL_VarRead ( CatchCNFmt ,'T2_M', T2, __RC__) + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt1,offset1=1, __RC__) ! 30 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_pt2,offset1=2, __RC__) ! 31 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st1,offset1=3, __RC__) ! 32 + call MAPL_VarRead(CatchCNFmt,'ITY',CLMC_st2,offset1=4, __RC__) ! 33 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf1,offset1=1, __RC__) ! 34 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_pf2,offset1=2, __RC__) ! 35 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf1,offset1=3, __RC__) ! 36 + call MAPL_VarRead(CatchCNFmt,'FVG',CLMC_sf2,offset1=4, __RC__) ! 37 call CatchCNFmt%close() if(clm45) then open(unit=30, file=trim(DataDir)//'CLM4.5_abm_peatf_gdp_hdm_fc' ,form='formatted') @@ -1758,7 +1766,7 @@ SUBROUTINE read_bcs_data (ntiles, SURFLAY,MODEL, DataDir, InRestart) deallocate (CLMC_pf1, CLMC_pf2, CLMC_sf1) deallocate (CLMC_sf2, CLMC_pt1, CLMC_pt2) deallocate (CLMC_st1,CLMC_st2) - + _RETURN(_SUCCESS) END SUBROUTINE read_bcs_data ! ***************************************************************************** @@ -1786,6 +1794,7 @@ SUBROUTINE regrid_carbon_vars (NTILES, model) real, allocatable :: var_off_col (:,:,:), var_off_pft (:,:,:,:) integer, allocatable :: low_ind(:), upp_ind(:), nt_local (:) real , pointer , dimension (:) :: long, latg, lonc, latc + character*256 :: Iam = "regrid_carbon_vars" OutFileName='OutData/'//trim(model)//'_internal_rst' @@ -2042,7 +2051,9 @@ SUBROUTINE write_regridded_carbon (NTILES, ntiles_rst, NCFID, OUTID, id_glb, & real, allocatable :: var_col_out (:,:,:), var_pft_out (:,:,:,:) integer :: N, STATUS, nv, nx, offl_cell, ityp_new, i, j, nz, iv real :: fveg_new - + character(256) :: Iam = "write_regridded_carbon" + + allocate (CLMC_pf1(NTILES)) allocate (CLMC_pf2(NTILES)) allocate (CLMC_sf1(NTILES)) @@ -2528,6 +2539,7 @@ SUBROUTINE put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_fil type(FileMetadata) :: meta_data integer :: STATUS, NCFID, OUTID character(*), intent (in), optional :: rst_file + character(256) :: Iam = "put_land_vars" allocate (var_get (NTILES_RST)) allocate (var_put (NTILES)) @@ -2535,23 +2547,23 @@ SUBROUTINE put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_fil ! create output catchcn_internal_rst if(index(model,'catchcn') /=0) then if (clm45) then - call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_clm45',PFIO_READ, rc=rc) ; VERIFY_(RC) + call InFmt%open('/discover/nobackup/projects/gmao/ssd/land/l_data/LandRestarts_for_Regridding/CatchCN/catchcn_internal_clm45',PFIO_READ, __RC__) else - call InFmt%open(trim(InCNRestart ), pFIO_READ, rc=rc) + call InFmt%open(trim(InCNRestart ), pFIO_READ, __RC__) endif endif if(trim(model) == 'catch' ) then - call InFmt%open(trim(InCatRestart), pFIO_READ, rc=rc) + call InFmt%open(trim(InCatRestart), pFIO_READ, __RC__) endif - meta_data = InFmt%read(rc=rc) - call InFmt%close(rc=rc) + meta_data = InFmt%read(__RC__) + call InFmt%close(__RC__) - call meta_data%modify_dimension('tile', ntiles, rc=rc) + call meta_data%modify_dimension('tile', ntiles, __RC__) OutFileName = "InData/"//trim(model)//"_internal_rst" - call OutFmt%create(trim(OutFileName),rc=rc) ; VERIFY_(RC) - call OutFmt%write(meta_data,rc=rc) + call OutFmt%create(trim(OutFileName),__RC__) + call OutFmt%write(meta_data,__RC__) if (present(rst_file)) then STATUS = NF_OPEN (trim(rst_file ),NF_NOWRITE,NCFID) ; VERIFY_(STATUS) @@ -2983,7 +2995,7 @@ SUBROUTINE put_land_vars (NTILES, ntiles_rst, id_glb, ld_reorder, model, rst_fil call MAPL_VarWrite(OutFmt,'CQ',VAR_PUT ,offset1=k) end do - call OutFmt%close(rc=rc) ; VERIFY_(RC) + call OutFmt%close(__RC__) STATUS = NF_CLOSE ( NCFID) deallocate (var_get, var_put) @@ -3382,65 +3394,67 @@ SUBROUTINE write_bin (unit, InFmt, NTILES) real :: cq(ntiles,4) real :: fr(ntiles,4) real :: ww(ntiles,4) - - call MAPL_VarRead(InFmt,"BF1",bf1) - call MAPL_VarRead(InFmt,"BF2",bf2) - call MAPL_VarRead(InFmt,"BF3",bf3) - call MAPL_VarRead(InFmt,"VGWMAX",vgwmax) - call MAPL_VarRead(InFmt,"CDCR1",cdcr1) - call MAPL_VarRead(InFmt,"CDCR2",cdcr2) - call MAPL_VarRead(InFmt,"PSIS",psis) - call MAPL_VarRead(InFmt,"BEE",bee) - call MAPL_VarRead(InFmt,"POROS",poros) - call MAPL_VarRead(InFmt,"WPWET",wpwet) - call MAPL_VarRead(InFmt,"COND",cond) - call MAPL_VarRead(InFmt,"GNU",gnu) - call MAPL_VarRead(InFmt,"ARS1",ars1) - call MAPL_VarRead(InFmt,"ARS2",ars2) - call MAPL_VarRead(InFmt,"ARS3",ars3) - call MAPL_VarRead(InFmt,"ARA1",ara1) - call MAPL_VarRead(InFmt,"ARA2",ara2) - call MAPL_VarRead(InFmt,"ARA3",ara3) - call MAPL_VarRead(InFmt,"ARA4",ara4) - call MAPL_VarRead(InFmt,"ARW1",arw1) - call MAPL_VarRead(InFmt,"ARW2",arw2) - call MAPL_VarRead(InFmt,"ARW3",arw3) - call MAPL_VarRead(InFmt,"ARW4",arw4) - call MAPL_VarRead(InFmt,"TSA1",tsa1) - call MAPL_VarRead(InFmt,"TSA2",tsa2) - call MAPL_VarRead(InFmt,"TSB1",tsb1) - call MAPL_VarRead(InFmt,"TSB2",tsb2) - call MAPL_VarRead(InFmt,"ATAU",atau) - call MAPL_VarRead(InFmt,"BTAU",btau) - call MAPL_VarRead(InFmt,"OLD_ITY",ity) - call MAPL_VarRead(InFmt,"TC",tc) - call MAPL_VarRead(InFmt,"QC",qc) - call MAPL_VarRead(InFmt,"OLD_ITY",ity) - call MAPL_VarRead(InFmt,"CAPAC",capac) - call MAPL_VarRead(InFmt,"CATDEF",catdef) - call MAPL_VarRead(InFmt,"RZEXC",rzexc) - call MAPL_VarRead(InFmt,"SRFEXC",srfexc) - call MAPL_VarRead(InFmt,"GHTCNT1",ghtcnt1) - call MAPL_VarRead(InFmt,"GHTCNT2",ghtcnt2) - call MAPL_VarRead(InFmt,"GHTCNT3",ghtcnt3) - call MAPL_VarRead(InFmt,"GHTCNT4",ghtcnt4) - call MAPL_VarRead(InFmt,"GHTCNT5",ghtcnt5) - call MAPL_VarRead(InFmt,"GHTCNT6",ghtcnt6) - call MAPL_VarRead(InFmt,"TSURF",tsurf) - call MAPL_VarRead(InFmt,"WESNN1",wesnn1) - call MAPL_VarRead(InFmt,"WESNN2",wesnn2) - call MAPL_VarRead(InFmt,"WESNN3",wesnn3) - call MAPL_VarRead(InFmt,"HTSNNN1",htsnnn1) - call MAPL_VarRead(InFmt,"HTSNNN2",htsnnn2) - call MAPL_VarRead(InFmt,"HTSNNN3",htsnnn3) - call MAPL_VarRead(InFmt,"SNDZN1",sndzn1) - call MAPL_VarRead(InFmt,"SNDZN2",sndzn2) - call MAPL_VarRead(InFmt,"SNDZN3",sndzn3) - call MAPL_VarRead(InFmt,"CH",ch) - call MAPL_VarRead(InFmt,"CM",cm) - call MAPL_VarRead(InFmt,"CQ",cq) - call MAPL_VarRead(InFmt,"FR",fr) - call MAPL_VarRead(InFmt,"WW",ww) + character*256 :: Iam = "Write bin" + integer :: status + + call MAPL_VarRead(InFmt,"BF1",bf1, __RC__) + call MAPL_VarRead(InFmt,"BF2",bf2, __RC__) + call MAPL_VarRead(InFmt,"BF3",bf3, __RC__) + call MAPL_VarRead(InFmt,"VGWMAX",vgwmax, __RC__) + call MAPL_VarRead(InFmt,"CDCR1",cdcr1, __RC__) + call MAPL_VarRead(InFmt,"CDCR2",cdcr2, __RC__) + call MAPL_VarRead(InFmt,"PSIS",psis, __RC__) + call MAPL_VarRead(InFmt,"BEE",bee, __RC__) + call MAPL_VarRead(InFmt,"POROS",poros, __RC__) + call MAPL_VarRead(InFmt,"WPWET",wpwet, __RC__) + call MAPL_VarRead(InFmt,"COND",cond, __RC__) + call MAPL_VarRead(InFmt,"GNU",gnu, __RC__) + call MAPL_VarRead(InFmt,"ARS1",ars1, __RC__) + call MAPL_VarRead(InFmt,"ARS2",ars2, __RC__) + call MAPL_VarRead(InFmt,"ARS3",ars3, __RC__) + call MAPL_VarRead(InFmt,"ARA1",ara1, __RC__) + call MAPL_VarRead(InFmt,"ARA2",ara2, __RC__) + call MAPL_VarRead(InFmt,"ARA3",ara3, __RC__) + call MAPL_VarRead(InFmt,"ARA4",ara4, __RC__) + call MAPL_VarRead(InFmt,"ARW1",arw1, __RC__) + call MAPL_VarRead(InFmt,"ARW2",arw2, __RC__) + call MAPL_VarRead(InFmt,"ARW3",arw3, __RC__) + call MAPL_VarRead(InFmt,"ARW4",arw4, __RC__) + call MAPL_VarRead(InFmt,"TSA1",tsa1, __RC__) + call MAPL_VarRead(InFmt,"TSA2",tsa2, __RC__) + call MAPL_VarRead(InFmt,"TSB1",tsb1, __RC__) + call MAPL_VarRead(InFmt,"TSB2",tsb2, __RC__) + call MAPL_VarRead(InFmt,"ATAU",atau, __RC__) + call MAPL_VarRead(InFmt,"BTAU",btau, __RC__) + call MAPL_VarRead(InFmt,"OLD_ITY",ity, __RC__) + call MAPL_VarRead(InFmt,"TC",tc, __RC__) + call MAPL_VarRead(InFmt,"QC",qc, __RC__) + call MAPL_VarRead(InFmt,"OLD_ITY",ity, __RC__) + call MAPL_VarRead(InFmt,"CAPAC",capac, __RC__) + call MAPL_VarRead(InFmt,"CATDEF",catdef, __RC__) + call MAPL_VarRead(InFmt,"RZEXC",rzexc, __RC__) + call MAPL_VarRead(InFmt,"SRFEXC",srfexc, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT1",ghtcnt1, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT2",ghtcnt2, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT3",ghtcnt3, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT4",ghtcnt4, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT5",ghtcnt5, __RC__) + call MAPL_VarRead(InFmt,"GHTCNT6",ghtcnt6, __RC__) + call MAPL_VarRead(InFmt,"TSURF",tsurf, __RC__) + call MAPL_VarRead(InFmt,"WESNN1",wesnn1, __RC__) + call MAPL_VarRead(InFmt,"WESNN2",wesnn2, __RC__) + call MAPL_VarRead(InFmt,"WESNN3",wesnn3, __RC__) + call MAPL_VarRead(InFmt,"HTSNNN1",htsnnn1, __RC__) + call MAPL_VarRead(InFmt,"HTSNNN2",htsnnn2, __RC__) + call MAPL_VarRead(InFmt,"HTSNNN3",htsnnn3, __RC__) + call MAPL_VarRead(InFmt,"SNDZN1",sndzn1, __RC__) + call MAPL_VarRead(InFmt,"SNDZN2",sndzn2, __RC__) + call MAPL_VarRead(InFmt,"SNDZN3",sndzn3, __RC__) + call MAPL_VarRead(InFmt,"CH",ch, __RC__) + call MAPL_VarRead(InFmt,"CM",cm, __RC__) + call MAPL_VarRead(InFmt,"CQ",cq, __RC__) + call MAPL_VarRead(InFmt,"FR",fr, __RC__) + call MAPL_VarRead(InFmt,"WW",ww, __RC__) write(unit) bf1 write(unit) bf2 @@ -3518,14 +3532,14 @@ SUBROUTINE read_ldas_restarts (NTILES, ntiles_rst, id_glb, ld_reorder, rst_file allocate (var_get (NTILES_RST)) allocate (var_put (NTILES)) - call InFmt%Open(trim(InCatRestart), pFIO_READ, rc=rc) - meta_data = InFmt%read(rc=rc) + call InFmt%Open(trim(InCatRestart), pFIO_READ, __RC__) + meta_data = InFmt%read(__RC__) call InFmt%close() - call meta_data%modify_dimension('tile', ntiles, rc=rc) + call meta_data%modify_dimension('tile', ntiles, __RC__) OutFileName = "InData/catch_internal_rst" - call OutFmt%create(OutFileName, rc=rc) - call OutFmt%write(meta_data, rc=rc) + call OutFmt%create(OutFileName, __RC__) + call OutFmt%write(meta_data, __RC__) open(10, file=trim(rst_file), form='unformatted', status='old', & convert='big_endian', action='read') diff --git a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 index c31babdfe..8682376ef 100644 --- a/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 +++ b/GEOSagcm_GridComp/GEOSphysics_GridComp/GEOSsurface_GridComp/Utils/mk_restarts/mk_LakeLandiceSaltRestarts.F90 @@ -1,3 +1,5 @@ +#define I_AM_MAIN +#include "MAPL_Generic.h" program mk_LakeLandiceSaltRestarts use netcdf @@ -43,7 +45,7 @@ program mk_LakeLandiceSaltRestarts type(StringVector), pointer :: var_dimensions character(len=:), pointer :: vname,dname integer :: dataType - + integer :: status !--------------------------------------------------------------------------- I = iargc() @@ -115,13 +117,13 @@ program mk_LakeLandiceSaltRestarts write(*,*)"Writing ",trim(vname) if (ndims == 1) then if (dataType == pFIO_REAL64) then - call MAPL_VarRead(InFmt,vname,varIn8) + call MAPL_VarRead(InFmt,vname,varIn8, __RC__) do i=1,otiles varOut8(i) = varIn8(id(i)) enddo call MAPL_VarWrite(OutFmt,vname,varOut8) else - call MAPL_VarRead(InFmt,vname,varIn) + call MAPL_VarRead(InFmt,vname,varIn, __RC__) do i=1,otiles varOut(i) = varIn(id(i)) enddo @@ -134,13 +136,13 @@ program mk_LakeLandiceSaltRestarts do j=1,dim1 if (dataType == pFIO_REAL64) then - call MAPL_VarRead(InFmt,vname,varIn8,offset1=j) + call MAPL_VarRead(InFmt,vname,varIn8,offset1=j, __RC__) do i=1,otiles varOut8(i) = varIn8(id(i)) enddo call MAPL_VarWrite(OutFmt,vname,varOut8,offset1=j) else - call MAPL_VarRead(InFmt,vname,varIn,offset1=j) + call MAPL_VarRead(InFmt,vname,varIn,offset1=j, __RC__) do i=1,otiles varOut(i) = varIn(id(i)) enddo @@ -157,13 +159,13 @@ program mk_LakeLandiceSaltRestarts do k=1,dim2 do j=1,dim1 if (dataType == pFIO_REAL64) then - call MAPL_VarRead(InFmt,vname,varIn8,offset1=j,offset2=k) + call MAPL_VarRead(InFmt,vname,varIn8,offset1=j,offset2=k, __RC__) do i=1,otiles varOut8(i) = varIn8(id(i)) enddo call MAPL_VarWrite(OutFmt,vname,varOut8,offset1=j,offset2=k) else - call MAPL_VarRead(InFmt,vname,varIn,offset1=j,offset2=k) + call MAPL_VarRead(InFmt,vname,varIn,offset1=j,offset2=k, __RC__) do i=1,otiles varOut(i) = varIn(id(i)) enddo