!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- *s/r wrrstrt_phy - Write the restart file restart_BUSPER_$date * #include "model_macros_f.h"*
subroutine wrrstrt_phy (F_spin_L) 2,2 implicit none * logical F_spin_L *author * M. Desgagne - Mars 2008 * *revision * v3_31 - Desgagne M. - initial MPI version * *implicits #include "lun.cdk"
#include "lctl.cdk"
#include "itf_phy_buses.cdk"
#include "grd.cdk"
#include "cstv.cdk"
#include "init.cdk"
#include "rstr.cdk"
#include "modconst.cdk"
* * *modules integer fnom,fclos external fnom,fclos * character*512 fn character*16 datev integer dim,unf,ier,ibuf(4),datstp,adr real rbuf(6) real*8 dayfrac, sec_in_day parameter (sec_in_day=86400.0d0) * * --------------------------------------------------------------- * dim = p_bper_siz*p_nj if (dim.le.0) return * unf = 0 * dayfrac = dble(Lctl_step) * Cstv_dt_8 / sec_in_day call incdatsd
(datev,Mod_runstrt_S,dayfrac) call datp2f
(datstp,datev) * fn='restart_BUSPER' if (F_spin_L) fn='BUSPER4spinphy_'//trim(datev) * ier = fnom (unf,fn,'RND',0) call waopen (unf) * if (Lun_out.gt.0) write(Lun_out,2000) Lctl_step,trim(fn) * ibuf(1) = datstp ibuf(2) = dim ibuf(3) = Grd_ni ibuf(4) = Grd_nj * rbuf(1) = Grd_dx rbuf(2) = Grd_dy rbuf(3) = Grd_xlon1 rbuf(4) = Grd_xlat1 rbuf(5) = Grd_xlon2 rbuf(6) = Grd_xlat2 * call wawrit (unf,ibuf , 1, 4) call wawrit (unf,rbuf , 5, 6) call wawrit (unf,Phy_busper3D,11,dim) adr = 11 + dim if ( Init_balgm_L .and. .not.Rstri_idon_L .and. Rstri_half_L) then call wawrit (unf,.true.,adr,1) adr = adr + 1 call wawrit (unf,Phy_busper3D_digf,adr,dim) else call wawrit (unf,.false.,adr,1) endif * call waclos(unf) ier = fclos(unf) * 2000 format(/,'WRITING A PHYSICS RESTART FILE AT TIMESTEP #',I8,x,a, + /,'============================================') * * --------------------------------------------------------------- * return end