! ! $Id $ ! SUBROUTINE dynetat0(fichnom,vcov,ucov, . teta,q,masse,ps,phis,time0) USE infotrac, only: tname, nqtot use netcdf, only: nf90_open,NF90_NOWRITE,nf90_noerr,nf90_strerror, & nf90_get_var, nf90_inq_varid, nf90_inq_dimid, & nf90_inquire_dimension,nf90_close use control_mod, only : planet_type, timestart USE comvert_mod, ONLY: pa,preff USE comconst_mod, ONLY: im,jm,lllm,daysec,dtvr, . rad,omeg,g,cpp,kappa,pi USE logic_mod, ONLY: fxyhypb,ysinus USE serre_mod, ONLY: clon,clat,grossismx,grossismy USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn, . start_time,day_ini,hour_ini USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 IMPLICIT NONE c======================================================================= c c Auteur: P. Le Van / L.Fairhead c ------- c c objet: c ------ c c Lecture de l'etat initial c c======================================================================= c----------------------------------------------------------------------- c Declarations: c ------------- #include "dimensions.h" #include "paramet.h" #include "comgeom2.h" #include "netcdf.inc" #include "iniprint.h" c Arguments: c ---------- CHARACTER(len=*),INTENT(IN) :: fichnom REAL,INTENT(OUT) :: vcov(iip1,jjm,llm) REAL,INTENT(OUT) :: ucov(iip1,jjp1,llm) REAL,INTENT(OUT) :: teta(iip1,jjp1,llm) REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot) REAL,INTENT(OUT) :: masse(iip1,jjp1,llm) REAL,INTENT(OUT) :: ps(iip1,jjp1) REAL,INTENT(OUT) :: phis(iip1,jjp1) REAL,INTENT(OUT) :: time0 c Variables c INTEGER length,iq PARAMETER (length = 100) REAL tab_cntrl(length) ! tableau des parametres du run INTEGER ierr, nid, nvarid character(len=12) :: start_file_type="earth" ! default start file type INTEGER idecal REAL,ALLOCATABLE :: time(:) ! times stored in start INTEGER timelen ! number of times stored in the file INTEGER indextime ! index of selected time !REAL hour_ini ! fraction of day of stored date. Equivalent of day_ini, but 0= est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, tab_cntrl) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echoue pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF !!! AS: idecal is a hack to be able to read planeto starts... !!! .... while keeping everything OK for LMDZ EARTH if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then write(lunout,*)'dynetat0 : Planeto-like start file' start_file_type="planeto" idecal = 4 annee_ref = 2000 else write(lunout,*)'dynetat0 : Earth-like start file' idecal = 5 annee_ref = tab_cntrl(5) endif im = tab_cntrl(1) jm = tab_cntrl(2) lllm = tab_cntrl(3) if (start_file_type.eq."earth") then day_ref = tab_cntrl(4) else day_ini = tab_cntrl(4) day_ref=0 endif 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) c clon = tab_cntrl(idecal+15) clat = tab_cntrl(idecal+16) grossismx = tab_cntrl(idecal+17) grossismy = tab_cntrl(idecal+18) c IF ( tab_cntrl(idecal+19).EQ.1. ) THEN fxyhypb = . TRUE . c dzoomx = tab_cntrl(25) c dzoomy = tab_cntrl(26) c taux = tab_cntrl(28) c tauy = tab_cntrl(29) ELSE fxyhypb = . FALSE . ysinus = . FALSE . IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE. ENDIF if (planet_type=="mars") then ! so far this is only for Mars hour_ini = tab_cntrl(29) else hour_ini=0 endif if (start_file_type.eq."earth") then day_ini = tab_cntrl(30) itau_dyn = tab_cntrl(31) start_time = tab_cntrl(32) else day_ini=tab_cntrl(4) itau_dyn=0 start_time=0 endif c ................................................................. c c write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa ', & rad,omeg,g,cpp,kappa IF( im.ne.iim ) THEN PRINT 1,im,iim STOP ELSE IF( jm.ne.jjm ) THEN PRINT 2,jm,jjm STOP ELSE IF( lllm.ne.llm ) THEN PRINT 3,lllm,llm STOP ENDIF ierr=nf90_inq_varid(nid, "rlonu", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, rlonu) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "rlatu", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, rlatu) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "rlonv", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, rlonv) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "rlatv", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, rlatv) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour rlatv" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "cu", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, cu) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "cv", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, cv) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "aire", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, aire) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_inq_varid (nid, "phisinit", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ierr = nf90_get_var(nid, nvarid, phis) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Lecture echouee pour " write(lunout,*)trim(nf90_strerror(ierr)) CALL ABORT_gcm("dynetat0", "", 1) ENDIF ! read time axis ierr = nf90_inq_varid (nid, "temps", nvarid) IF (ierr .NE. nf90_noerr) THEN write(lunout,*)"dynetat0: Le champ est absent" write(lunout,*)"dynetat0: J essaie