SUBROUTINE dynetat0(fichnom,vcov,ucov,teta,q,masse,ps,phis,time) ! !------------------------------------------------------------------------------- ! Authors: P. Le Van , L.Fairhead !------------------------------------------------------------------------------- ! Purpose: Initial state reading. !------------------------------------------------------------------------------- USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, & new2oldH2O, newHNO3, oldHNO3, getKey USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, & NF90_CLOSE, NF90_GET_VAR, NF90_NoErr USE control_mod, ONLY: planet_type USE assert_eq_m, ONLY: assert_eq USE comvert_mod, ONLY: pa,preff USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad USE logic_mod, ONLY: fxyhypb, ysinus USE serre_mod, ONLY: clon, clat, grossismx, grossismy USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 IMPLICIT NONE include "dimensions.h" include "paramet.h" include "comgeom2.h" include "description.h" include "iniprint.h" !=============================================================================== ! Arguments: CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME REAL, INTENT(OUT) :: vcov(iip1,jjm, llm) !--- V COVARIANT WIND REAL, INTENT(OUT) :: ucov(iip1,jjp1,llm) !--- U COVARIANT WIND REAL, INTENT(OUT) :: teta(iip1,jjp1,llm) !--- POTENTIAL TEMP. REAL, INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) !--- TRACERS REAL, INTENT(OUT) :: masse(iip1,jjp1,llm) !--- MASS PER CELL REAL, INTENT(OUT) :: ps(iip1,jjp1) !--- GROUND PRESSURE REAL, INTENT(OUT) :: phis(iip1,jjp1) !--- GEOPOTENTIAL !=============================================================================== ! Local variables: CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar INTEGER, PARAMETER :: length=100 INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase REAL :: time, tnat, alpha_ideal, tab_cntrl(length) !--- RUN PARAMS TABLE LOGICAL :: lSkip, ll LOGICAL,PARAMETER :: tnat1=.TRUE. !------------------------------------------------------------------------------- modname="dynetat0" !--- Initial state file opening var=fichnom CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var) CALL get_var1("controle",tab_cntrl) !!! AS: idecal is a hack to be able to read planeto starts... !!! .... while keeping everything OK for LMDZ EARTH IF(planet_type=="generic") THEN CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname) idecal = 4 annee_ref = 2000 ELSE CALL msg('NOTE NOTE NOTE : Earth-like start files', modname) idecal = 5 annee_ref = tab_cntrl(5) END IF im = tab_cntrl(1) jm = tab_cntrl(2) lllm = tab_cntrl(3) day_ref = tab_cntrl(4) rad = tab_cntrl(idecal+1) omeg = tab_cntrl(idecal+2) g = tab_cntrl(idecal+3) cpp = tab_cntrl(idecal+4) kappa = tab_cntrl(idecal+5) daysec = tab_cntrl(idecal+6) dtvr = tab_cntrl(idecal+7) etot0 = tab_cntrl(idecal+8) ptot0 = tab_cntrl(idecal+9) ztot0 = tab_cntrl(idecal+10) stot0 = tab_cntrl(idecal+11) ang0 = tab_cntrl(idecal+12) pa = tab_cntrl(idecal+13) preff = tab_cntrl(idecal+14) ! clon = tab_cntrl(idecal+15) clat = tab_cntrl(idecal+16) grossismx = tab_cntrl(idecal+17) grossismy = tab_cntrl(idecal+18) ! IF ( tab_cntrl(idecal+19)==1. ) THEN fxyhypb = .TRUE. ! dzoomx = tab_cntrl(25) ! dzoomy = tab_cntrl(26) ! taux = tab_cntrl(28) ! tauy = tab_cntrl(29) ELSE fxyhypb = .FALSE. ysinus = tab_cntrl(idecal+22)==1. END IF day_ini = tab_cntrl(30) itau_dyn = tab_cntrl(31) start_time = tab_cntrl(32) !------------------------------------------------------------------------------- CALL msg('rad, omeg, g, cpp, kappa = '//TRIM(strStack(real2str([rad,omeg,g,cpp,kappa]))), modname) CALL check_dim(im,iim,'im','im') CALL check_dim(jm,jjm,'jm','jm') CALL check_dim(lllm,llm,'lm','lllm') CALL get_var1("rlonu",rlonu) CALL get_var1("rlatu",rlatu) CALL get_var1("rlonv",rlonv) CALL get_var1("rlatv",rlatv) CALL get_var2("cu" ,cu) CALL get_var2("cv" ,cv) CALL get_var2("aire" ,aire) var="temps" IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN CALL msg('Missing field ; trying with