! source file: /Users/oschlies/UVIC/master/source/embm/embm_rest.F subroutine embm_rest_in (fname, ids, ide, jds, jde) !======================================================================= ! input routine for atmospheric 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 "param.h" include "atm.h" include "cembm.h" include "coord.h" include "csbc.h" include "evp.h" include "grdvar.h" include "ice.h" include "tmngr.h" include "switch.h" character(*) :: fname character(3) :: a3 character(120) :: var1, var2 integer iou, ln, n, ntrec, ids, ide, jds, jde, ig integer ils, ile, jls, jle, ib(10), ic(10) integer nyear, nmonth, nday, nhour, nmin, nsec logical inqvardef, exists real tmp real, allocatable :: tmpij(:,:) !----------------------------------------------------------------------- ! 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) ) !----------------------------------------------------------------------- ! read 1d data (t) !----------------------------------------------------------------------- tmp = nats call getvars ('nats', iou, ntrec, tmp, c1, c0) nats = 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 = totaltime call getvars ('totaltime', iou, ntrec, tmp, c1, c0) totaltime = 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 tmp = co2ccn call getvars ('co2ccn', iou, ntrec, tmp, c1, c0) co2ccn = tmp !----------------------------------------------------------------------- ! 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) do n=1,nat if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n var1 = 'at1_'//trim(a3) var2 = 'at2_'//trim(a3) if (trim(mapat(n)) .eq. 'sat') then if (inqvardef('slat1', iou)) var1 = 'slat1' if (inqvardef('slat2', iou)) var2 = 'slat2' elseif (trim(mapat(n)) .eq. 'shum') then if (inqvardef('shum1', iou)) var1 = 'shum1' if (inqvardef('shum2', iou)) var2 = 'shum2' elseif (trim(mapat(n)) .eq. 'co2') then if (inqvardef('co21', iou)) var1 = 'co21' if (inqvardef('co22', iou)) var2 = 'co22' endif tmpij(ils:ile,jls:jle) = at(ils:ile,jls:jle,1,n) call getvara(trim(var1), iou, ln, ib, ic, tmpij, c1, c0) at(ils:ile,jls:jle,1,n) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = at(ils:ile,jls:jle,2,n) call getvara(trim(var2), iou, ln, ib, ic, tmpij, c1, c0) at(ils:ile,jls:jle,2,n) = tmpij(ils:ile,jls:jle) enddo tmpij(ils:ile,jls:jle) = rh(ils:ile,jls:jle) call getvara ('rh', iou, ln, ib, ic, tmpij, c1, c0) rh(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = precip(ils:ile,jls:jle) call getvara ('precip', iou, ln, ib, ic, tmpij, c1, c0) precip(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isst) call getvara ('sbc_sst', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isst) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isss) call getvara ('sbc_sss', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isss) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ihflx) call getvara ('sbc_hflx', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,ihflx) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isflx) call getvara ('sbc_sflx', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isflx) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issdic) call getvara ('sbc_ssdic', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,issdic) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issc14) call getvara ('sbc_ssc14', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,issc14) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isso2) call getvara ('sbc_sso2', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isso2) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issalk) call getvara ('sbc_ssalk', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,issalk) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = soilm(ils:ile,jls:jle,1) call getvara ('soilm1', iou, ln, ib, ic, tmpij, c1, c0) soilm(ils:ile,jls:jle,1) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = soilm(ils:ile,jls:jle,2) call getvara ('soilm2', iou, ln, ib, ic, tmpij, c1, c0) soilm(ils:ile,jls:jle,2) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = surf(ils:ile,jls:jle) call getvara ('surf', iou, ln, ib, ic, tmpij, c1, c0) surf(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = tice(ils:ile,jls:jle) call getvara ('tice', iou, ln, ib, ic, tmpij, c1, c0) tice(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = hice(ils:ile,jls:jle,1) call getvara ('hice1', iou, ln, ib, ic, tmpij, c1, c0) hice(ils:ile,jls:jle,1) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = hice(ils:ile,jls:jle,2) call getvara ('hice2', iou, ln, ib, ic, tmpij, c1, c0) hice(ils:ile,jls:jle,2) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = aice(ils:ile,jls:jle,1) call getvara ('aice1', iou, ln, ib, ic, tmpij, c1, c0) aice(ils:ile,jls:jle,1) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = aice(ils:ile,jls:jle,2) call getvara ('aice2', iou, ln, ib, ic, tmpij, c1, c0) aice(ils:ile,jls:jle,2) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = hsno(ils:ile,jls:jle,1) call getvara ('hsno1', iou, ln, ib, ic, tmpij, c1, c0) hsno(ils:ile,jls:jle,1) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = hsno(ils:ile,jls:jle,2) call getvara ('hsno2', iou, ln, ib, ic, tmpij, c1, c0) hsno(ils:ile,jls:jle,2)= tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = uice(ils:ile,jls:jle) call getvara ('uice', iou, ln, ib, ic, tmpij, c1, c0) uice(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = vice(ils:ile,jls:jle) call getvara ('vice', iou, ln, ib, ic, tmpij, c1, c0) vice(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isu) call getvara ('su', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isu) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isv) call getvara ('sv', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,isv) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,igu) call getvara ('gu', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,igu) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,igv) call getvara ('gv', iou, ln, ib, ic, tmpij, c1, c0) sbc(ils:ile,jls:jle,igv) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig11n(ils:ile,jls:jle) call getvara ('sig11n', iou, ln, ib, ic, tmpij, c1, c0) sig11n(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig11s(ils:ile,jls:jle) call getvara ('sig11s', iou, ln, ib, ic, tmpij, c1, c0) sig11s(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig11e(ils:ile,jls:jle) call getvara ('sig11e', iou, ln, ib, ic, tmpij, c1, c0) sig11e(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig11w(ils:ile,jls:jle) call getvara ('sig11w', iou, ln, ib, ic, tmpij, c1, c0) sig11w(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig22n(ils:ile,jls:jle) call getvara ('sig22n', iou, ln, ib, ic, tmpij, c1, c0) sig22n(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig22s(ils:ile,jls:jle) call getvara ('sig22s', iou, ln, ib, ic, tmpij, c1, c0) sig22s(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig22e(ils:ile,jls:jle) call getvara ('sig22e', iou, ln, ib, ic, tmpij, c1, c0) sig22e(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig22w(ils:ile,jls:jle) call getvara ('sig22w', iou, ln, ib, ic, tmpij, c1, c0) sig22w(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig12n(ils:ile,jls:jle) call getvara ('sig12n', iou, ln, ib, ic, tmpij, c1, c0) sig12n(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig12s(ils:ile,jls:jle) call getvara ('sig12s', iou, ln, ib, ic, tmpij, c1, c0) sig12s(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig12e(ils:ile,jls:jle) call getvara ('sig12e', iou, ln, ib, ic, tmpij, c1, c0) sig12e(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) tmpij(ils:ile,jls:jle) = sig12w(ils:ile,jls:jle) call getvara ('sig12w', iou, ln, ib, ic, tmpij, c1, c0) sig12w(ils:ile,jls:jle) = tmpij(ils:ile,jls:jle) !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- print*, '=> Atm restart read from ',trim(fname),' on ', stamp deallocate ( tmpij ) call closefile (iou) return end subroutine embm_rest_def (fname) !======================================================================= ! definition routine for atmospheric restarts ! inputs: ! fname = file name ! based on code by: M. Eby !======================================================================= implicit none include "param.h" include "atm.h" include "ice.h" include "iounit.h" include "tmngr.h" character(*) :: fname character(3) :: a3 integer iou, n, igs, ige, ig, jgs, jge, jg, it(10), iu(10) integer id_time, id_xt, id_xu, id_yt, id_yu, id_xt_e, id_xu_e integer id_yt_e, id_yu_e real c1e20 c1e20 = 1.e20 !----------------------------------------------------------------------- ! open file !----------------------------------------------------------------------- call openfile (fname, iou) !----------------------------------------------------------------------- ! 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(1) = id_time call defvar ('time', iou, 1, it, c0, c0, 'T', 'D' &, 'time since initial condition', 'time', trim(timunit)) call defvar ('nats', iou, 1, it, c0, c0, ' ', 'D' &, 'nats', ' ',' ') 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 ('totaltime', iou, 1, it, c0, c0, ' ', 'D' &, 'totaltime', ' ',' ') 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', ' ',' ') call defvar ('co2ccn', iou, 1, it, c0, c0, ' ', 'D' &, 'co2ccn', ' ','') !----------------------------------------------------------------------- ! 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 do n=1,nat if (trim(mapat(n)) .eq. 'sat') then call defvar ('slat1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sea level atmospheric temperature at tau', ' ', ' ') call defvar ('slat2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sea level atmospheric temperature at tau+1', ' ', ' ') elseif (trim(mapat(n)) .eq. 'shum') then call defvar ('shum1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'atmospheric surface specific humidity at tau', ' ', ' ') call defvar ('shum2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'atmospheric surface specific humidity at tau+1', ' ', ' ') elseif (trim(mapat(n)) .eq. 'co2') then call defvar ('co21', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'atmospheric co2 at tau', ' ', ' ') call defvar ('co22', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'atmospheric co2 at tau+1', ' ', ' ') else 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 ('at1_'//trim(a3), iou , 3, it, -c1e20, c1e20, ' ' &, 'D', 'at1_'//trim(a3), ' ', ' ') call defvar ('at2_'//trim(a3), iou , 3, it, -c1e20, c1e20, ' ' &, 'D', 'at2_'//trim(a3), ' ', ' ') endif enddo call defvar ('rh', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'rh', ' ', ' ') call defvar ('precip', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'precip', ' ', ' ') call defvar ('sbc_sst', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sst', ' ', ' ') call defvar ('sbc_sss', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sss', ' ', ' ') call defvar ('sbc_hflx', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sst', ' ', ' ') call defvar ('sbc_sflx', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sss', ' ', ' ') call defvar ('sbc_ssdic', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'ssdic', ' ', ' ') call defvar ('sbc_ssc14', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'ssc14', ' ', ' ') call defvar ('sbc_sso2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sso2', ' ', ' ') call defvar ('sbc_ssalk', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'ssalk', ' ', ' ') call defvar ('soilm1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'soilm1', ' ', ' ') call defvar ('soilm2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'soilm2', ' ', ' ') call defvar ('surf', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'surf', ' ', ' ') call defvar ('tice', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'tice', ' ', ' ') call defvar ('hice1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'hice1', ' ', ' ') call defvar ('hice2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'hice2', ' ', ' ') call defvar ('aice1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'aice1', ' ', ' ') call defvar ('aice2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'aice2', ' ', ' ') call defvar ('hsno1', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'hsno1', ' ', ' ') call defvar ('hsno2', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'hsno2', ' ', ' ') call defvar ('uice', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'uice', ' ', ' ') call defvar ('vice', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'vice', ' ', ' ') call defvar ('su', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'su', ' ', ' ') call defvar ('sv', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'sv', ' ', ' ') call defvar ('gu', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'gu', ' ', ' ') call defvar ('gv', iou, 3, iu, -c1e20, c1e20, ' ', 'D' &, 'gv', ' ', ' ') call defvar ('sig11n', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig11n', ' ', ' ') call defvar ('sig11s', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig11s', ' ', ' ') call defvar ('sig11e', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig11e', ' ', ' ') call defvar ('sig11w', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig11w', ' ', ' ') call defvar ('sig22n', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig22n', ' ', ' ') call defvar ('sig22s', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig22s', ' ', ' ') call defvar ('sig22e', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig22e', ' ', ' ') call defvar ('sig22w', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig22w', ' ', ' ') call defvar ('sig12n', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig12n', ' ', ' ') call defvar ('sig12s', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig12s', ' ', ' ') call defvar ('sig12e', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig12e', ' ', ' ') call defvar ('sig12w', iou, 3, it, -c1e20, c1e20, ' ', 'D' &, 'sig12w', ' ', ' ') call enddef (iou) !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- call closefile (iou) return end subroutine embm_rest_out (fname, ids, ide, jds, jde) !======================================================================= ! output routine for atmospheric 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 "param.h" include "atm.h" include "cembm.h" include "coord.h" include "csbc.h" include "evp.h" include "grdvar.h" include "ice.h" include "tmngr.h" include "iounit.h" include "switch.h" character(*) :: fname character(3) :: a3 character(32) :: lstamp character(120) :: var1, var2 integer i, iou, j, ln, n, ntrec, ids, ide, jds, jde, igs, ige, ig integer jgs, jge, jg, ils, ile, jls, jle, ib(10), ic(10) integer nyear, nmonth, nday, nhour, nmin, nsec logical inqvardef, exists real xt_e(imt+1), xu_e(imt+1), yt_e(jmt+1), yu_e(jmt+1) real time, tmp, c1e20 real, allocatable :: tmpij(:,:) real, allocatable :: tmpi(:), tmpj(:) real, allocatable :: tmpie(:), tmpje(:) c1e20 = 1.e20 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) ) !----------------------------------------------------------------------- ! write 1d data (t) !----------------------------------------------------------------------- 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 tmp = nats call putvars ('nats', iou, ntrec, tmp, c1, c0) tmp = dayoyr call putvars ('dayoyr', iou, ntrec, tmp, c1, c0) call putvars ('totaltime', iou, ntrec, totaltime, c1, c0) 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) tmp = co2ccn call putvars ('co2ccn', iou, ntrec, tmp, c1, c0) !----------------------------------------------------------------------- ! write 1d data (x or y) !----------------------------------------------------------------------- allocate ( tmpi(igs:ige) ) allocate ( tmpj(jgs:jge) ) allocate ( tmpie(igs:ige+1) ) allocate ( tmpje(jgs:jge+1) ) 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) deallocate ( tmpi ) deallocate ( tmpj ) deallocate ( tmpie ) deallocate ( tmpje ) !----------------------------------------------------------------------- ! 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) do n=1,nat if (trim(mapat(n)) .eq. 'sat') then var1 = 'slat1' var2 = 'slat2' elseif (trim(mapat(n)) .eq. 'shum') then var1 = 'shum1' var2 = 'shum2' elseif (trim(mapat(n)) .eq. 'co2') then var1 = 'co21' var2 = 'co22' else if (n .lt. 1000) write(a3, '(i3)') n if (n .lt. 100) write(a3, '(i2)') n if (n .lt. 10) write(a3, '(i1)') n var1 = 'at1_'//trim(a3) var2 = 'at2_'//trim(a3) endif tmpij(ils:ile,jls:jle) = at(ils:ile,jls:jle,1,n) call putvara(trim(var1), iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = at(ils:ile,jls:jle,2,n) call putvara(trim(var2), iou, ln, ib, ic, tmpij, c1, c0) enddo tmpij(ils:ile,jls:jle) = rh(ils:ile,jls:jle) call putvara ('rh', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = precip(ils:ile,jls:jle) call putvara ('precip', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isst) call putvara ('sbc_sst', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isss) call putvara ('sbc_sss', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,ihflx) call putvara ('sbc_hflx', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isflx) call putvara ('sbc_sflx', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issdic) call putvara ('sbc_ssdic', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issc14) call putvara ('sbc_ssc14', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isso2) call putvara ('sbc_sso2', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,issalk) call putvara ('sbc_ssalk', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = soilm(ils:ile,jls:jle,1) call putvara ('soilm1', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = soilm(ils:ile,jls:jle,2) call putvara ('soilm2', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = surf(ils:ile,jls:jle) call putvara ('surf', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = tice(ils:ile,jls:jle) call putvara ('tice', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = hice(ils:ile,jls:jle,1) call putvara ('hice1', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = hice(ils:ile,jls:jle,2) call putvara ('hice2', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = aice(ils:ile,jls:jle,1) call putvara ('aice1', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = aice(ils:ile,jls:jle,2) call putvara ('aice2', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = hsno(ils:ile,jls:jle,1) call putvara ('hsno1', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = hsno(ils:ile,jls:jle,2) call putvara ('hsno2', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = uice(ils:ile,jls:jle) call putvara ('uice', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = vice(ils:ile,jls:jle) call putvara ('vice', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isu) call putvara ('su', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,isv) call putvara ('sv', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,igu) call putvara ('gu', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sbc(ils:ile,jls:jle,igv) call putvara ('gv', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig11n(ils:ile,jls:jle) call putvara ('sig11n', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig11s(ils:ile,jls:jle) call putvara ('sig11s', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig11e(ils:ile,jls:jle) call putvara ('sig11e', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig11w(ils:ile,jls:jle) call putvara ('sig11w', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig22n(ils:ile,jls:jle) call putvara ('sig22n', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig22s(ils:ile,jls:jle) call putvara ('sig22s', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig22e(ils:ile,jls:jle) call putvara ('sig22e', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig22w(ils:ile,jls:jle) call putvara ('sig22w', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig12n(ils:ile,jls:jle) call putvara ('sig12n', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig12s(ils:ile,jls:jle) call putvara ('sig12s', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig12e(ils:ile,jls:jle) call putvara ('sig12e', iou, ln, ib, ic, tmpij, c1, c0) tmpij(ils:ile,jls:jle) = sig12w(ils:ile,jls:jle) call putvara ('sig12w', iou, ln, ib, ic, tmpij, c1, c0) !----------------------------------------------------------------------- ! close the file !----------------------------------------------------------------------- print*, '=> Atm restart written to ',trim(fname),' on ', lstamp deallocate ( tmpij ) call closefile (iou) return end