! ! $Id: initphysto.F 1299 2010-01-20 14:27:21Z jyg $ ! C C subroutine initphysto . (infile, . rlon, rlat, tstep,t_ops,t_wrt,nq,fileid) USE dimphy USE mod_phys_lmdz_para USE IOIPSL USE iophy USE control_mod implicit none C C Routine d'initialisation des ecritures des fichiers histoires LMDZ C au format IOIPSL C C Appels succesifs des routines: histbeg C histhori C histver C histdef C histend C C Entree: C C infile: nom du fichier histoire a creer C day0,anne0: date de reference C tstep: duree du pas de temps en seconde C t_ops: frequence de l'operation pour IOIPSL C t_wrt: frequence d'ecriture sur le fichier C nq: nombre de traceurs C C Sortie: C fileid: ID du fichier netcdf cree C filevid:ID du fichier netcdf pour la grille v C C L. Fairhead, LMD, 03/99 C C ===================================================================== C C Declarations #include "dimensions.h" #include "paramet.h" #include "comconst.h" #include "comgeom.h" #include "temps.h" #include "ener.h" #include "logic.h" #include "description.h" #include "serre.h" #include "indicesol.h" cym#include "dimphy.h" C Arguments character*(*) infile integer nhoriid, i real tstep, t_ops, t_wrt integer fileid, filevid integer nq,l real nivsigs(llm) C Variables locales C integer tau0 real zjulian character*3 str character*10 ctrac integer iq integer uhoriid, vhoriid, thoriid, zvertiid integer ii,jj integer zan, idayref logical ok_sync REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) C REAL rlon(klon), rlat(klon) C Initialisations C pi = 4. * atan (1.) str='q ' ctrac = 'traceur ' ok_sync= .true. C C Appel a histbeg: creation du fichier netcdf et initialisations diverses C zan = annee_ref idayref = day_ref CALL ymds2ju(zan, 1, idayref, 0.0, zjulian) tau0 = 0 cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon) cym DO i = 1, iim cym zx_lon(i,1) = rlon(i+1) cym zx_lon(i,jjm+1) = rlon(i+1) cym ENDDO cym CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat) call histbeg_phy(infile,tau0, zjulian, tstep, . nhoriid, fileid) c$OMP MASTER C Appel a histvert pour la grille verticale C DO l=1,llm nivsigs(l)=REAL(l) ENDDO write(*,*) 'avant histvert ds initphysto' call histvert(fileid, 'sig_s', 'Niveaux sigma', . 'sigma_level', . llm, nivsigs, zvertiid) C C Appels a histdef pour la definition des variables a sauvegarder C write(*,*) 'apres histvert ds initphysto' CALL histdef(fileid, "phis", "Surface geop. height", "-", . iim,jj_nb,nhoriid, 1,1,1, -99, 32, . "once", t_ops, t_wrt) c write(*,*) 'apres phis ds initphysto' CALL histdef(fileid, "aire", "Grid area", "-", . iim,jj_nb,nhoriid, 1,1,1, -99, 32, . "once", t_ops, t_wrt) write(*,*) 'apres aire ds initphysto' cym Attention dtime et istphy ne sont pas �rit ---> a �iminer ? CALL histdef(fileid, "dtime", "tps phys ", "s", . 1,1,nhoriid, 1,1,1, -99, 32, . "once", t_ops, t_wrt) CALL histdef(fileid, "istphy", "tps stock", "s", . 1,1,nhoriid, 1,1,1, -99, 32, . "once", t_ops, t_wrt) C T C call histdef(fileid, 't', 'Temperature', 'K', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) write(*,*) 'apres t ds initphysto' C mfu C call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) write(*,*) 'apres mfu ds initphysto' C C mfd C call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C en_u C call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) write(*,*) 'apres en_u ds initphysto' C C de_u C call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C en_d C call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) C C C de_d C call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) c coefh frac_impa,frac_nucl call histdef(fileid, "coefh", " ", " ", . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, "inst(X)", t_ops, t_wrt) c abderrahmane le 16 09 02 call histdef(fileid, "fm_th", " ", " ", . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, "inst(X)", t_ops, t_wrt) call histdef(fileid, "en_th", " ", " ", . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, "inst(X)", t_ops, t_wrt) c fin aj write(*,*) 'apres coefh ds initphysto' call histdef(fileid, 'frac_impa', ' ', ' ', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) call histdef(fileid, 'frac_nucl', ' ', ' ', . iim, jj_nb, nhoriid, llm, 1, llm, zvertiid, . 32, 'inst(X)', t_ops, t_wrt) c c pyu1 c CALL histdef(fileid, "pyu1", " ", " ", . iim,jj_nb,nhoriid, 1,1,1, -99, 32, . "inst(X)", t_ops, t_wrt) c c pyv1 c CALL histdef(fileid, "pyv1", " ", " ", . iim,jj_nb,nhoriid, 1,1,1, -99, 32, . "inst(X)", t_ops, t_wrt) write(*,*) 'apres pyv1 ds initphysto' c c ftsol1 c call histdef(fileid, "ftsol1", " ", " ", . iim, jj_nb, nhoriid, 1, 1,1, -99,32, . "inst(X)", t_ops, t_wrt) c c ftsol2 c call histdef(fileid, "ftsol2", " ", " ", . iim, jj_nb, nhoriid, 1, 1,1, -99,32, . "inst(X)", t_ops, t_wrt) c c ftsol3 c call histdef(fileid, "ftsol3", " ", " ", . iim, jj_nb, nhoriid, 1, 1,1, -99, . 32, "inst(X)", t_ops, t_wrt) c c ftsol4 c call histdef(fileid, "ftsol4", " ", " ", . iim, jj_nb, nhoriid, 1, 1,1, -99, . 32, "inst(X)", t_ops, t_wrt) c c rain c call histdef(fileid, "rain", " ", " ", . iim, jj_nb, nhoriid, 1, 1,1, -99, . 32, "inst(X)", t_ops, t_wrt) c c psrf1 c call histdef(fileid, "psrf1", " ", " ", . iim, jj_nb, nhoriid, 1, 1, 1, -99, . 32, "inst(X)", t_ops, t_wrt) c c psrf2 c call histdef(fileid, "psrf2", " ", " ", . iim, jj_nb, nhoriid, 1, 1, 1, -99, . 32, "inst(X)", t_ops, t_wrt) c c psrf3 c call histdef(fileid, "psrf3", " ", " ", . iim, jj_nb, nhoriid, 1, 1, 1, -99, . 32, "inst(X)", t_ops, t_wrt) c c psrf4 c call histdef(fileid, "psrf4", " ", " ", . iim, jj_nb, nhoriid, 1, 1, 1, -99, . 32, "inst(X)", t_ops, t_wrt) write(*,*) 'avant histend ds initphysto' call histend(fileid) c if (ok_sync) call histsync(fileid) if (ok_sync) call histsync c$OMP END MASTER return end