! source file: /Users/oschlies/UVIC/master/source/mtlm/mtlm_rest.F subroutine mtlm_rest_in (fname, ids, ide, jds, jde) !======================================================================= ! input routine for land restarts ! data may be sized differently in x and y from the global fields. ! fields may be written with or without a time dimension. data ! should be defined with the routine defvar and written with putvar. ! if no time dimension, then data is only written once per file. ! make sure the it, iu, ib, and ic arrays and are defining the ! correct dimensions. ln may also need to be recalculated. ! inputs: ! fname = file name ! ids, ide ... = start and end index for data domain ! based on code by: M. Eby !======================================================================= implicit none include "size.h" include "coord.h" include "grdvar.h" include "csbc.h" include "levind.h" include "tmngr.h" include "switch.h" include "mtlm.h" character(*) :: fname character(3) :: a3 integer i, iou, j, k, ln, n, ntrec, ids, ide, jds, jde, ils, ile integer jls, jle, ib(10), ic(10), undef, L, mskl(imt,jmt) integer mskt(imt,jmt) integer nyear, nmonth, nday, nhour, nmin, nsec logical exists, inqvardef real data(imt,jmt), tmp, c0, c1 real, allocatable :: tmpij(:,:) c0 = 0. c1 = 1. undef = 0. !----------------------------------------------------------------------- ! open file !----------------------------------------------------------------------- call openfile (fname, iou) ntrec = 1 !----------------------------------------------------------------------- ! local domain size (minimum of data domain and global read domain) !----------------------------------------------------------------------- ils = max(ids,1) ile = min(ide,imt) jls = max(jds,1) jle = min(jde,jmt) allocate ( tmpij(ils:ile,jls:jle) ) L = 0 ! mskl is the map of current maximum possible land points mskl(:,:) = 0 ! mskt is the map of current maximum possible land points in restart mskt(:,:) = 0 do j=2,jmt-1 do i=2,imt-1 if (kmt(i,j) .le. klmax) then L = L + 1 mskl(i,j) = L endif if (kmt(i,j) .le. 0) mskt(i,j) = L enddo enddo !----------------------------------------------------------------------- ! read 1d data (t) !----------------------------------------------------------------------- tmp = undef call getvars ('POINTS', iou, ntrec, tmp, c1, c0) if (tmp .gt. POINTS .or. tmp .le. 0. .or. tmp .eq. undef) then i = tmp print*, "==> Warning: Points in restart is inconsistent" print*, " restart: ", i, "model: ",POINTS print*, " retarting land model from initial values" call closefile (iou) return endif tmp = atlnd call getvars ('atlnd', iou, ntrec, tmp, c1, c0) atlnd = tmp tmp = LAND_COUNTER call getvars ('LAND_COUNTER', iou, ntrec, tmp, c1, c0) LAND_COUNTER = tmp tmp = dayoyr call getvars ('dayoyr', iou, ntrec, tmp, c1, c0) dayoyr = tmp tmp = itt call getvars ('itt', iou, ntrec, tmp, c1, c0) itt = tmp tmp = irstdy call getvars ('irstdy', iou, ntrec, tmp, c1, c0) irstdy = tmp tmp = msrsdy call getvars ('msrsdy', iou, ntrec, tmp, c1, c0) msrsdy = tmp tmp = year0 call getvars ('year', iou, ntrec, tmp, c1, c0) nyear = tmp tmp = month0 call getvars ('month', iou, ntrec, tmp, c1, c0) nmonth = tmp tmp = day0 call getvars ('day', iou, ntrec, tmp, c1, c0) nday = tmp tmp = hour0 call getvars ('hour', iou, ntrec, tmp, c1, c0) nhour = tmp tmp = min0 call getvars ('minute', iou, ntrec, tmp, c1, c0) nmin = tmp tmp = sec0 call getvars ('second', iou, ntrec, tmp, c1, c0) nsec = tmp call mkstmp (stamp, nyear, nmonth, nday, nhour, nmin, nsec) if (init_time_in) then itt = 0 irstdy = 0 msrsdy = 0 relyr = 0.0 call mkstmp (stamp, year0, month0, day0, hour0, min0, sec0) endif !----------------------------------------------------------------------- ! read 3d data (x,y,t) !----------------------------------------------------------------------- ib(1) = 1 ic(1) = ile-ils+1 ib(2) = 1 ic(2) = jle-jls+1 ib(3) = ntrec ic(3) = 1 ln = ic(1)*ic(2)*ic(3) tmpij(ils:ile,jls:jle) = mskt(ils:ile,jls:jle) call getvara ('mskl', iou, ln, ib, ic, tmpij, c1, c0) mskt(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = land_map(ils:ile,jls:jle) call getvara ('land_map', iou, ln, ib, ic, tmpij, c1, c0) land_map(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call unloadland (POINTS, TSOIL, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('TSOIL', iou, ln, ib, ic, tmpij, c1, c0) data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, TSOIL, imt, jmt, mskl, data) call unloadland (POINTS, LYING_SNOW, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('LYING_SNOW', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, LYING_SNOW, imt, jmt, mskl, data) call unloadland (POINTS, TS1, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('TS1', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, TS1, imt, jmt, mskl, data) call unloadland (POINTS, CS, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('CS', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, CS, imt, jmt, mskl, data) call unloadland (POINTS, CV, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('CV', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, CV, imt, jmt, mskl, data) call unloadland (POINTS, VEG_FRAC, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('VEG_FRAC', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, VEG_FRAC, imt, jmt, mskl, data) call unloadland (POINTS, FRAC_VS, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('FRAC_VS', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, FRAC_VS, imt, jmt, mskl, data) call unloadland (POINTS, M, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('M', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, M, imt, jmt, mskl, data) call unloadland (POINTS, MNEG, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('MNEG', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, MNEG, imt, jmt, mskl, data) call unloadland (POINTS, FSMC, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('FSMC', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, FSMC, imt, jmt, mskl, data) call unloadland (POINTS, RESP_S_DR, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('RESP_S_DR', iou, ln, ib, ic, tmpij, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, RESP_S_DR, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isca) call getvara ('sbc_sca', iou, ln, ib, ic, tmpij, c1, c0) ! only use land points so other values can be changed do j=jls,jle do i=ils,ile if (mskl(i,j) .gt. 0) sbc(i,j,isca) = tmpij(i,j) enddo enddo tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ilwr) call getvara ('sbc_lwr', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,ilwr) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isens) call getvara ('sbc_sens', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isens) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ievap) call getvara ('sbc_evap', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,ievap) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,inpp) call getvara ('sbc_npp', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,inpp) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isr) call getvara ('sbc_sr', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isr) = tmpij(ils:ile,jls:jle) do n=1,npft if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n call unloadland (POINTS, TSTAR(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('TSTAR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, TSTAR(1,n), imt, jmt, mskl, data) call unloadland (POINTS, ALBSNF(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('ALBSNF_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, ALBSNF(1,n), imt, jmt, mskl, data) call unloadland (POINTS, ALBSNC(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('ALBSNC_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, ALBSNC(1,n), imt, jmt, mskl, data) call unloadland (POINTS, HT(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('HT_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, HT(1,n), imt, jmt, mskl, data) call unloadland (POINTS, LAI(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('LAI_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, LAI(1,n), imt, jmt, mskl, data) call unloadland (POINTS, C_VEG(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('CVEG_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, C_VEG(1,n), imt, jmt, mskl, data) call unloadland (POINTS, G_LEAF_PHEN(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('G_LEAF_PHEN_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, G_LEAF_PHEN(1,n), imt, jmt, mskl &, data) call unloadland (POINTS, G_LEAF_DR(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('G_LEAF_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, G_LEAF_DR(1,n), imt, jmt, mskl &, data) call unloadland (POINTS, NPP_DR(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('NPP_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, NPP_DR(1,n), imt, jmt, mskl, data) call unloadland (POINTS, RESP_W_DR(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('RESP_W_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, RESP_W_DR(1,n), imt, jmt, mskl &, data) call unloadland (POINTS, CATCH(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('CATCH_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, CATCH(1,n), imt, jmt, mskl, data) call unloadland (POINTS, Z0(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('Z0_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, Z0(1,n), imt, jmt, mskl, data) enddo do n=1,ntype if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n call unloadland (POINTS, FRAC(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call getvara ('FRAC_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) where (mskt(ils:ile,jls:jle) .ne. 0) & data(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) call loadland (POINTS, FRAC(1,n), imt, jmt, mskl, data) enddo !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- print*, '=> Lnd restart read from ',trim(fname),' on ', stamp deallocate ( tmpij ) call closefile (iou) return end subroutine mtlm_rest_def (fname) !======================================================================= ! definition routine for land restarts ! inputs: ! fname = file name ! based on code by: M. Eby !======================================================================= implicit none include "size.h" include "iounit.h" include "tmngr.h" character(*) :: fname character(3) :: a3 character(32) :: lstamp integer i, iou, j, ln, n, ntrec, igs, ige, ig, jgs, jge, jg integer it(10), iu(10), id_time, id_xt, id_xu, id_yt, id_yu integer id_xt_e, id_xu_e, id_yt_e, id_yu_e real c0, c1, c1e5, c1e20 c0 = 0. c1 = 1. c1e5 = 1.e5 c1e20 = 1.e20 !----------------------------------------------------------------------- ! open file !----------------------------------------------------------------------- call openfile (fname, iou) ntrec = 1 !----------------------------------------------------------------------- ! set global write domain size !----------------------------------------------------------------------- igs = 1 ige = imt ig = ige-igs+1 jgs = 1 jge = jmt jg = jge-jgs+1 !----------------------------------------------------------------------- ! start definitions !----------------------------------------------------------------------- call redef (iou) !----------------------------------------------------------------------- ! write global attributes !----------------------------------------------------------------------- call putatttext (iou, 'global', 'Conventions', 'CF-1.0') call putatttext (iou, 'global', 'experiment_name', expnam) call putatttext (iou, 'global', 'run_stamp', runstamp) call putatttext (iou, 'global', 'time_unit', timunit) !----------------------------------------------------------------------- ! define dimensions !----------------------------------------------------------------------- call defdim ('time', iou, 0, id_time) call defdim ('xt', iou, ig, id_xt) call defdim ('yt', iou, jg, id_yt) call defdim ('xu', iou, ig, id_xu) call defdim ('yu', iou, jg, id_yu) call defdim ('xt_edges', iou, ig+1, id_xt_e) call defdim ('yt_edges', iou, jg+1, id_yt_e) call defdim ('xu_edges', iou, ig+1, id_xu_e) call defdim ('yu_edges', iou, jg+1, id_yu_e) !----------------------------------------------------------------------- ! define 1d data (t) !----------------------------------------------------------------------- it(:) = id_time call defvar ('time', iou, 1, it, c0, c0, 'T', 'D' &, 'time since initial condition', 'time', trim(timunit)) call defvar ('POINTS', iou, 1, it, c0, c0, ' ', 'D' &, 'POINTS', ' ',' ') call defvar ('atlnd', iou, 1, it, c0, c0, ' ', 'D' &, 'atlnd', ' ',' ') call defvar ('LAND_COUNTER', iou, 1, it, c0, c0, ' ', 'D' &, 'LAND_COUNTER', ' ',' ') call defvar ('dayoyr', iou, 1, it, c0, c0, ' ', 'D' &, 'dayoyr', ' ',' ') call defvar ('itt', iou, 1, it, c0, c0, ' ', 'D' &, 'itt', ' ',' ') call defvar ('irstdy', iou, 1, it, c0, c0, ' ', 'D' &, 'irstdy', ' ',' ') call defvar ('msrsdy', iou, 1, it, c0, c0, ' ', 'D' &, 'msrsdy', ' ',' ') call defvar ('year', iou, 1, it, c0, c0, ' ', 'D' &, 'year', ' ',' ') call defvar ('month', iou, 1, it, c0, c0, ' ', 'D' &, 'month', ' ',' ') call defvar ('day', iou, 1, it, c0, c0, ' ', 'D' &, 'day', ' ',' ') call defvar ('hour', iou, 1, it, c0, c0, ' ', 'D' &, 'hour', ' ',' ') call defvar ('minute', iou, 1, it, c0, c0, ' ', 'D' &, 'minute', ' ',' ') call defvar ('second', iou, 1, it, c0, c0, ' ', 'D' &, 'second', ' ',' ') !----------------------------------------------------------------------- ! define 1d data (x, y or z) !----------------------------------------------------------------------- it(1) = id_xt call defvar ('xt', iou, 1, it, c0, c0, 'X', 'D' &, 'longitude of the t grid', 'grid_longitude', 'degrees_east') it(1) = id_yt call defvar ('yt', iou, 1, it, c0, c0, 'Y', 'D' &, 'latitude of the t grid', 'grid_latitude', 'degrees_north') it(1) = id_xu call defvar ('xu', iou, 1, it, c0, c0, 'X', 'D' &, 'longitude of the u grid', 'grid_longitude', 'degrees_east') it(1) = id_yu call defvar ('yu', iou, 1, it, c0, c0, 'Y', 'D' &, 'latitude of the u grid', 'grid_latitude', 'degrees_north') it(1) = id_xt_e call defvar ('xt_edges', iou, 1, it, c0, c0, ' ', 'D' &, 'longitude of t grid edges', ' ', 'degrees') it(1) = id_yt_e call defvar ('yt_edges', iou, 1, it, c0, c0, ' ', 'D' &, 'latitude of t grid edges', ' ', 'degrees') it(1) = id_xu_e call defvar ('xu_edges', iou, 1, it, c0, c0, ' ', 'D' &, 'longitude of u grid edges', ' ', 'degrees') it(1) = id_yu_e call defvar ('yu_edges', iou, 1, it, c0, c0, ' ', 'D' &, 'latitude of u grid edges', ' ', 'degrees') !----------------------------------------------------------------------- ! define 3d data (x,y,t) !----------------------------------------------------------------------- it(1) = id_xt iu(1) = id_xu it(2) = id_yt iu(2) = id_yu it(3) = id_time iu(3) = id_time call defvar ('mskl', iou , 3, it, c0, c1e5, ' ', 'I' &, 'mskl', ' ', ' ') call defvar ('land_map', iou , 3, it, c0, c1e5, ' ', 'I' &, 'land_map', ' ', ' ') call defvar ('TSOIL', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'TSOIL', ' ', ' ') call defvar ('LYING_SNOW', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'LYING_SNOW', ' ', ' ') call defvar ('TS1', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'TS1', ' ', ' ') call defvar ('CS', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'CS', ' ', ' ') call defvar ('CV', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'CV', ' ', ' ') call defvar ('VEG_FRAC', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'VEG_FRAC', ' ', ' ') call defvar ('FRAC_VS', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'FRAC_VS', ' ', ' ') call defvar ('M', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'M', ' ', ' ') call defvar ('FSMC', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'FSMC', ' ', ' ') call defvar ('RESP_S_DR', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'RESP_S_DR', ' ', ' ') call defvar ('MNEG', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'MNEG', ' ', ' ') call defvar ('sbc_sca', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_sca', ' ', ' ') call defvar ('sbc_lwr', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_lwr', ' ', ' ') call defvar ('sbc_sens', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_sens', ' ', ' ') call defvar ('sbc_evap', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_evap', ' ', ' ') call defvar ('sbc_npp', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_npp', ' ', ' ') call defvar ('sbc_sr', iou , 3, it, -c1e20, c1e20, ' ', 'D' &, 'sbc_sr', ' ', ' ') do n=1,nPFT if (n .lt. 1000) write(a3,'(i3)') n if (n .lt. 100) write(a3,'(i2)') n if (n .lt. 10) write(a3,'(i1)') n call defvar ('TSTAR_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'TSTAR_'//trim(a3), ' ', ' ') call defvar ('ALBSNF_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'ALBSNF_'//trim(a3), ' ', ' ') call defvar ('ALBSNC_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'ALBSNC_'//trim(a3), ' ', ' ') call defvar ('HT_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'HT_'//trim(a3), ' ', ' ') call defvar ('LAI_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'LAI_'//trim(a3) , ' ', ' ') call defvar ('CVEG_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'CVEG_'//trim(a3) , ' ', ' ') call defvar ('G_LEAF_PHEN_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'G_LEAF_PHEN_'//trim(a3), ' ', ' ') call defvar ('G_LEAF_DR_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'G_LEAF_DR_'//trim(a3), ' ', ' ') call defvar ('NPP_DR_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'NPP_DR_'//trim(a3), ' ', ' ') call defvar ('RESP_W_DR_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'RESP_W_DR_'//trim(a3), ' ', ' ') call defvar ('CATCH_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'CATCH_'//trim(a3), ' ', ' ') call defvar ('Z0_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'Z0_'//trim(a3), ' ', ' ') enddo do n=1,ntype if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n call defvar ('FRAC_'//trim(a3), iou , 3, it, -c1e20 &, c1e20, ' ', 'D', 'FRAC_'//trim(a3), ' ', ' ') enddo call enddef (iou) !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- call closefile (iou) return end subroutine mtlm_rest_out (fname, ids, ide, jds, jde) !======================================================================= ! output routine for land restarts ! data may be sized differently in x and y from the global fields. ! fields may be written with or without a time dimension. data ! should be defined with the routine defvar and written with putvar. ! if no time dimension, then data is only written once per file. ! make sure the it, iu, ib, and ic arrays and are defining the ! correct dimensions. ln may also need to be recalculated. ! inputs: ! fname = file name ! ids, ide ... = start and end index for data domain ! based on code by: M. Eby !======================================================================= implicit none include "size.h" include "coord.h" include "grdvar.h" include "csbc.h" include "levind.h" include "tmngr.h" include "switch.h" include "mtlm.h" include "iounit.h" character(*) :: fname character(3) :: a3 character(32) :: lstamp integer i, iou, j, k, ln, n, ntrec, ids, ide, jds, jde, igs, ige integer ig, jgs, jge, jg, ils, ile, jls, jle, ib(10), ic(10), L integer mskl(imt,jmt) integer nyear, nmonth, nday, nhour, nmin, nsec real xt_e(imt+1), xu_e(imt+1), yt_e(jmt+1), yu_e(jmt+1) real data(imt,jmt), tmp, c0, c1 real, allocatable :: tmpij(:,:) real, allocatable :: tmpi(:), tmpj(:) real, allocatable :: tmpie(:), tmpje(:) c0 = 0. c1 = 1. lstamp = stamp !----------------------------------------------------------------------- ! open file !----------------------------------------------------------------------- call openfile (fname, iou) ntrec = 1 !----------------------------------------------------------------------- ! set global write domain size !----------------------------------------------------------------------- igs = 1 ige = imt ig = ige-igs+1 jgs = 1 jge = jmt jg = jge-jgs+1 !----------------------------------------------------------------------- ! local domain size (minimum of data domain and global write domain) !----------------------------------------------------------------------- ils = max(ids,igs) ile = min(ide,ige) jls = max(jds,jgs) jle = min(jde,jge) allocate ( tmpij(ils:ile,jls:jle) ) allocate ( tmpi(ils:ile) ) allocate ( tmpj(jls:jle) ) allocate ( tmpie(ils:ile+1) ) allocate ( tmpje(jls:jle+1) ) L = 0 mskl(:,:) = 0 do j=2,jmt-1 do i=2,imt-1 if (kmt(i,j) .le. klmax) then L = L + 1 mskl(i,j) = L endif enddo enddo !----------------------------------------------------------------------- ! write 1d data (t) !----------------------------------------------------------------------- tmp = POINTS call putvars ('POINTS', iou, ntrec, tmp, c1, c0) tmp = LAND_COUNTER call putvars ('LAND_COUNTER', iou, ntrec, tmp, c1, c0) call putvars ('atlnd', iou, ntrec, atlnd, c1, c0) tmp = dayoyr call putvars ('dayoyr', iou, ntrec, tmp, c1, c0) if (init_time_out) then tmp = 0. call putvars ('time', iou, ntrec, 0., c1, c0) tmp = 0. call putvars ('itt', iou, ntrec, tmp, c1, c0) tmp = 0. call putvars ('irstdy', iou, ntrec, tmp, c1, c0) tmp = 0. call putvars ('msrsdy', iou, ntrec, tmp, c1, c0) call mkstmp (lstamp, year0, month0, day0, hour0, min0, sec0) else tmp = relyr call putvars ('time', iou, ntrec, 0., c1, c0) tmp = itt call putvars ('itt', iou, ntrec, tmp, c1, c0) tmp = iday(imodeltime) call putvars ('irstdy', iou, ntrec, tmp, c1, c0) tmp = msday(imodeltime) call putvars ('msrsdy', iou, ntrec, tmp, c1, c0) endif call rdstmp (lstamp, nyear, nmonth, nday, nhour, nmin, nsec) tmp = nyear call putvars ('year', iou, ntrec, tmp, c1, c0) tmp = nmonth call putvars ('month', iou, ntrec, tmp, c1, c0) tmp = nday call putvars ('day', iou, ntrec, tmp, c1, c0) tmp = nhour call putvars ('hour', iou, ntrec, tmp, c1, c0) tmp = nmin call putvars ('minute', iou, ntrec, tmp, c1, c0) tmp = nsec call putvars ('second', iou, ntrec, tmp, c1, c0) !----------------------------------------------------------------------- ! write 1d data (x or y) !----------------------------------------------------------------------- ib(1) = 1 ic(1) = ig tmpi(igs:ige) = xt(igs:ige) call putvara ('xt', iou, ig, ib, ic, tmpi, c1, c0) tmpi(igs:ige) = xu(igs:ige) call putvara ('xu', iou, ig, ib, ic, tmpi, c1, c0) ic(1) = jg tmpj(jgs:jge) = yt(jgs:jge) call putvara ('yt', iou, jg, ib, ic, tmpj, c1, c0) tmpj(jgs:jge) = yu(jgs:jge) call putvara ('yu', iou, jg, ib, ic, tmpj, c1, c0) ic(1) = ig + 1 call edge_maker (1, xt_e, xt, dxt, xu, dxu, imt) tmpie(igs:ige+1) = xt_e(igs:ige+1) call putvara ('xt_edges', iou, ig+1, ib, ic, tmpie, c1, c0) call edge_maker (2, xu_e, xt, dxt, xu, dxu, imt) tmpie(igs:ige+1) = xu_e(igs:ige+1) call putvara ('xu_edges', iou, ig+1, ib, ic, tmpie, c1, c0) ic(1) = jg + 1 call edge_maker (1, yt_e, yt, dyt, yu, dyu, jmt) tmpje(jgs:jge+1) = yt_e(jgs:jge+1) call putvara ('yt_edges', iou, jg+1, ib, ic, tmpje, c1, c0) call edge_maker (2, yu_e, yt, dyt, yu, dyu, jmt) tmpje(jgs:jge+1) = yu_e(jgs:jge+1) call putvara ('yu_edges', iou, jg+1, ib, ic, tmpje, c1, c0) !----------------------------------------------------------------------- ! write 3d data (x,y,t) !----------------------------------------------------------------------- ib(1) = 1 ic(1) = ile-ils+1 ib(2) = 1 ic(2) = jle-jls+1 ib(3) = ntrec ic(3) = 1 ln = ic(1)*ic(2)*ic(3) tmpij(ils:ile,jls:jle) = mskl(ils:ile,jls:jle) call putvara ('mskl', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = land_map(ils:ile,jls:jle) call putvara ('land_map', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, TSOIL, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('TSOIL', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, LYING_SNOW, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('LYING_SNOW', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, TS1, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('TS1', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, CS, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('CS', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, CV, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('CV', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, VEG_FRAC, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('VEG_FRAC', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, FRAC_VS, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('FRAC_VS', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, M, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('M', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, FSMC, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('FSMC', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, RESP_S_DR, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('RESP_S_DR', iou, ln, ib, ic, tmpij, c1, c0) call unloadland (POINTS, MNEG, imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('MNEG', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isca) call putvara ('sbc_sca', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ilwr) call putvara ('sbc_lwr', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isens) call putvara ('sbc_sens', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ievap) call putvara ('sbc_evap', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,inpp) call putvara ('sbc_npp', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isr) call putvara ('sbc_sr', iou, ln, ib, ic, tmpij, c1, c0) do n=1,npft if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n call unloadland (POINTS, TSTAR(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('TSTAR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, ALBSNF(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('ALBSNF_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, ALBSNC(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('ALBSNC_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, HT(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('HT_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, LAI(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('LAI_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, C_VEG(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('CVEG_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, G_LEAF_PHEN(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('G_LEAF_PHEN_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, G_LEAF_DR(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('G_LEAF_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, NPP_DR(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('NPP_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, RESP_W_DR(1,n), imt, jmt, mskl &, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('RESP_W_DR_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, CATCH(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('CATCH_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) call unloadland (POINTS, Z0(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('Z0_'//trim(a3), iou, ln, ib, ic, tmpij, c1, c0) enddo do n=1,ntype if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n call unloadland (POINTS, FRAC(1,n), imt, jmt, mskl, data) tmpij(ils:ile,jls:jle) = data(ils:ile,jls:jle) call putvara ('FRAC_'//trim(a3), iou, ln, ib, ic, tmpij &, c1, c0) enddo !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- print*, '=> Lnd restart written to ',trim(fname),' on ', lstamp deallocate ( tmpij ) deallocate ( tmpi ) deallocate ( tmpj ) deallocate ( tmpie ) deallocate ( tmpje ) call closefile (iou) return end