*=*=*=*= maketat0.html =*=*=*=*
PROGRAM maketat0 c c------------------------------------------------------------- C Author : L. Fairhead C Date : 14/12/93 C Objet : Construction des fichiers initiaux pour le nouveau C modele a partir de fichiers de climatologie. Les deux C grilles doivent etre regulieres c------------------------------------------------------------- c implicit none #include "dimensions.h" #include "paramet.h" #include "control.h" #include "logic.h" #include "drsdef.h" #include "comvert.h" #include "comgeom2.h" #include "comconst.h" C Declarations pour le champ de depart INTEGER imdep, jmdep, lmdep INTEGER ibid, jbid, lbid parameter (ibid = 500, . jbid = 500, . lbid = 50) REAL champ(ibid*jbid), champ3d(ibid*jbid*lbid) REAL dlon(ibid), dlat(jbid), plev(lbid) C Declarations pour le champ interpole 2D REAL champint(iim,jjp1) REAL champecrit(iip1,jjp1) REAL masque(iip1,jjp1) REAL psol(iip1,jjp1) REAL pext(iip1,jjp1) REAL phis(iip1,jjp1) C Declarations pour le champ interpole 3D REAL champhor(iip1,jjp1,lbid) REAL champ3decr(iip1,jjp1,llm) REAL ucov(iip1,jjp1,llm) REAL vcov(iip1,jjm,llm) REAL temp(iip1,jjp1,llm) REAL q(iip1,jjp1,llm) C Declarations pour l'inteprolation verticale REAL ax(lbid), ay(lbid) REAL bx(llm), by(llm) REAL yder(lbid) C Declarations liees a la description des variables (setname) character varsource*120 character varname*16, vartitle*80 character varunits*40, vartype*8 character vardate*8, vartime*8 character dimsource*120 character dimname*16, dimtitle*80 character dimunits*40, dimtype*8 character*80 drsname, filename C Declaration DRS INTEGER aslun, setname, putdat, cllun, cluvdb INTEGER putvdim, inqlun, inqdict, getname, getcdim, getdat INTEGER setvdim, setdim INTEGER ierr INTEGER ibid INTEGER ecdicphy, ecdatphy, intdicphy, intdatphy parameter (ecdicphy = 10, ecdatphy = 11) parameter (intdicphy = 20, intdatphy = 21) INTEGER ecdicdyn, ecdatdyn, intdicdyn, intdatdyn parameter (ecdicdyn = 30, ecdatdyn = 31) parameter (intdicdyn = 40, intdatdyn = 41) c Declarations pour les variables mises dans le fichier DRS INTEGER length parameter (length = 100) REAL tab_cntrl(length) ! tableau des parametres du run REAL dicfilver INTEGER nbas(iip1,jjp1), ntop(iip1,jjp1) REAL pacpr(iip1,jjp1) REAL pgz0f(iip1,jjp1) REAL r4 parameter(r4 = IDRS_BYTES_PER_WORD) INTEGER icount INTEGER iix(200000), jjx(200000), ix(200000), jx(200000) REAL sx(200000),airnx(200000) INTEGER i, j, numdim, k, l INTEGER ind1, indlast INTEGER varnumb REAL polenord, polesud INTEGER size REAL rlatu(jjp1), rlonv(iip1) REAL phystep, daysec, dtvr INTEGER radpas c Diverses variables locales REAL nivmer REAL pi REAL time logical ldrs INTEGER idayref REAL ttt, qs INTEGER nqllm, nbetat #include "fxy_sin.h" pi = 4. * atan(1.) nivmer = 10. ldrs = .true. rad=6400000. omeg=4.*asin(1.)/(24.*3600.) g=9.8 daysec=86400. c ###### P. Le Van ( Modif le 21/11/95 ) ####### c pour avoir R = 287.059 et CP = 1004.70 , comme dans physiq.F mugaz = 28.9645 kappa = 0.285716 C Initialisation de differents champs necessaires a l'etat intial open (8,file='run.def',form='formatted') call defrun(8) close(8) Calcul de la discretisation verticale CALL iniconst Calcul des coordonnees de la grille d'arrivee et des aires call inigeom dtvr = daysec/float(day_step) phystep = dtvr * float(iphysiq) radpas = nint (86400./phystep) do j = 1, jjp1 do i = 1, iip1 ntop(i,j) = 1 nbas(i,j) = 1 pacpr(i,j) = 0. pgz0f(i,j) = 1. enddo enddo C Lecture fichier physique Centre Europeen write(6,'(a,$)')'Fichier physique a lire ? : ' read (5,'(a)')drsname ierr = ASLUN(ecdicphy,drsname,ecdatphy,' ',IDRS_READ) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier a interpoler ' write(6,*)' ierr = ', ierr call exit(1) endif C Lecture de la date des donnees du fichier ierr = cluvdb() ierr = setname(' ','date',' ',' ',' ') ierr = inqdict(ecdicphy, IDRS_GETFIRSTVAR) size = r4 ierr = getdat(ecdicphy, champ, size) idayref = int(champ(1)) print *,'idayref', idayref C Lecture fichier dynamique Centre Europeen write(6,'(a,$)')'Fichier dynamique a lire ? : ' read (5,'(a)')drsname ierr = ASLUN(ecdicdyn,drsname,ecdatdyn,' ',IDRS_READ) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier a interpoler ' write(6,*)' ierr = ', ierr call exit(1) endif C Lecture de la date des donnees du fichier ierr = cluvdb() ierr = setname(' ','date',' ',' ',' ') ierr = inqdict(ecdicdyn, IDRS_GETFIRSTVAR) size = r4 ierr = getdat(ecdicdyn, champ, size) if (int(champ(1)).ne.idayref) then write(6,*)' La date du fichier dynamique <> fichier physique' write(6,*) int(champ(1)), idayref write(6,*)' Je m''arrete' stop endif C Ouverture fichier interpole write(6,'(a,$)')'Fichier de sortie physique? : ' read (5,'(a)')drsname ierr = ASLUN(intdicphy,drsname,intdatphy,' ',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier interpole ' write(6,*)' ierr = ', ierr call exit(1) endif C Ouverture fichier interpole write(6,'(a,$)')'Fichier de sortie dynamique? : ' read (5,'(a)')drsname ierr = ASLUN(intdicdyn,drsname,intdatdyn,' ',IDRS_CREATE) if (ierr.ne.0) then write(6,*)' Pb d''ouverture du fichier interpole ' write(6,*)' ierr = ', ierr call exit(1) endif c Traitement du fichier de conditions initiales pour la physique c Lecture du nombre de variables dans le fichier DRS physique ierr = INQLUN (ecdicphy,filename,varnumb, dicfilver) if (ierr.ne.IDRS_SUCCESS) then print*,' erreur inqlun',ierr call exit(1) endif write(6,*)' il y a ',varnumb,' variables dans le fichier' write(6,*)' ' C boucle sur toutes les variables du fichier pour les interpoler ierr = CLUVDB() ierr = SETNAME(' ',' ',' ',' ',' ') ierr = INQDICT(ecdicphy, IDRS_GETFIRSTVAR) C la 1ere variable est date, on ne l'interpole pas ierr = INQDICT(ecdicphy, IDRS_GETNEXTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = SETNAME(' ',varname,' ',' ',' ') ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) size = imdep * jmdep * r4 ierr = GETDAT(ecdicphy, champ, size) c interpolation call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) c Ecriture DRS du tableau des parametres du run tab_cntrl(1) = phystep tab_cntrl(2) = radpas tab_cntrl(3) = float(idayref) ierr = CLUVDB() ierr = SETDIM(1,'index',' ',length,1.,float(length)) ierr = SETNAME(varsource,'controle', . 'Tableau des parametres du run',' ',' ') ierr = PUTDAT(intdicphy,tab_cntrl) C Ecriture des coordonnees dans le fichier interpole ierr = CLUVDB() ierr = SETNAME(' ','longitude',' Longitudes','degres',' ') ierr = PUTVDIM(intdicphy,iip1,rlonv,ind1,indlast) ierr = SETNAME(' ','latitude',' Latitudes','degres',' ') ierr = PUTVDIM(intdicphy,jjp1,rlatu,ind1,indlast) C Ecriture des champs de nuages et de longueur de rugosite ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(' ', 'ntop', ' ', ' ', ' ') ierr = PUTDAT(intdicphy, ntop) ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(' ', 'nbas', ' ', ' ', ' ') ierr = PUTDAT(intdicphy, nbas) ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(' ', 'pacpr', ' ', ' ', ' ') ierr = PUTDAT(intdicphy, pacpr) ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(' ', 'pgz0f', ' ', ' ', ' ') ierr = PUTDAT(intdicphy, pgz0f) C Ecriture du champ interpole ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(varsource, varname, vartitle, varunits, vartype) ierr = PUTDAT(intdicphy, champecrit) do k = 3, varnumb ierr = INQDICT(ecdicphy, IDRS_GETNEXTVAR) ierr = GETNAME(varsource,varname,vartitle,varunits,vardate, . vartime,vartype, numdim) ierr = SETNAME(' ',varname,' ',' ',' ') ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) size = imdep * jmdep * r4 ierr = GETDAT(ecdicphy, champ, size) c interpolation call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) c ecriture du fichier interpole ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) ierr = SETNAME(varsource, varname, vartitle, varunits, vartype) ierr = PUTDAT(intdicphy, champecrit) enddo c Traitement du fichier de conditions initiales pour la dynamique C traitement du geopotentiel au sol ierr = cluvdb() ierr = SETNAME(' ','Z',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) size = imdep * jmdep * r4 ierr = GETDAT(ecdicdyn, champ, size) call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, phis, iim, jjp1) C creation du masque ocean/continent et ecriture dans le fichier physique do j = 1, jjp1 do i = 1, iip1 masque(i, j) = 1. if (phis(i, j) .lt. nivmer) then masque(i, j) = 0. phis(i, j) = 0. endif enddo enddo ierr = CLUVDB() ierr = SETVDIM(1,' ','longitude',' ',' ',rlonv(1), rlonv(iip1)) ierr = SETVDIM(2,' ','latitude',' ',' ',rlatu(1), rlatu(jjp1)) varname = 'PITM' vartitle = 'Masque continent / ocean (1/0)' varunits = ' ' vartype = ' ' ierr = SETNAME(varsource, varname, vartitle, varunits, vartype) ierr = PUTDAT(intdicphy, masque) ierr = cllun(intdicphy) ierr = cllun(ecdicphy) C Initialisation du fichier dynamique time = 0. call iniwrite(intdicdyn,ldrs, idayref, phis) C traitement de la pression au sol ierr = cluvdb() ierr = SETNAME(' ','SP',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) size = imdep * jmdep * r4 ierr = GETDAT(ecdicdyn, champ, size) call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, psol, iim, jjp1) Calcul pression extensive do j = 1, jjp1 do i = 1, iip1 pext(i, j) = psol(i, j) * aire(i, j) c pext(i, j) = psol(i, j) enddo enddo C Traitement du vent zonal ierr = cluvdb() ierr = SETNAME(' ','U',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype,lbid, plev, lmdep) size = imdep * jmdep * lmdep * r4 ierr = GETDAT(ecdicdyn, champ3d, size) C je suppose que les niveaux de pression sont numerotes de bas en haut: c psol = 1 c haut = lmdep c Interpolation horizontale do l = lmdep, 1, -1 do j = 1, jmdep do i = 1, imdep champ(imdep*(j-1)+i) = . champ3d(i + (j-1)*imdep + (l-1)*jmdep*imdep) enddo enddo call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonu, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) do j = 1, jjp1 do i = 1, iip1 champhor(i, j, (lmdep - l + 1)) = champecrit (i, j) enddo enddo enddo c Interpolation verticale par spline do j=1,jjp1 do i=1,iim do l=1,lmdep ax(l)=plev(lmdep - l + 1) enddo do l=1,llm bx(l)=sig_s(l)*psol(i, j)/ 100. enddo do l=1,lmdep ay(l)=champhor(i,j,l) enddo call SPLINE(ax,ay,lmdep,1e30,1.e30,yder) do l=1,llm call SPLINT(ax,ay,yder,lmdep,bx(l),by(l)) champ3decr(i,j,l)=by(l) enddo enddo do l = 1, llm champ3decr(iip1, j, l) = champ3decr(1, j, l) enddo enddo C Passage aux vents covariants do l = 1, llm do j=1,jjp1 do i = 1, iip1 ucov(i,j,l) = champ3decr(i,j,l) * cu (i, j) c ucov(i,j,l) = champ3decr(i,j,l) enddo enddo enddo C Traitement du vent meridien ierr = cluvdb() ierr = SETNAME(' ','V',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype,lbid, plev, lmdep) size = imdep * jmdep * lmdep * r4 ierr = GETDAT(ecdicdyn, champ3d, size) c Interpolation horizontale do l = lmdep, 1, -1 do j = 1, jmdep do i = 1, imdep champ(imdep*(j-1)+i) = . champ3d(i + (j-1)*imdep + (l-1)*jmdep*imdep) enddo enddo call linearb(imdep, jmdep, dlon, dlat, . iim, jjm, rlonv, rlatv, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjm, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) do j = 1, jjm do i = 1, iip1 champhor(i, j, (lmdep - l + 1)) = champecrit (i, j) enddo enddo enddo c Interpolation verticale par spline do j=1,jjm do i=1,iim c do l=1,lmdep c ax(l)=plev(lmdep - l + 1) c enddo c do l=1,llm c bx(l)=sig_s(l)*psol(i, j) c enddo do l=1,lmdep ay(l)=champhor(i,j,l) enddo call SPLINE(ax,ay,lmdep,1e30,1.e30,yder) do l=1,llm call SPLINT(ax,ay,yder,lmdep,bx(l),by(l)) vcov(i,j,l)=by(l) enddo enddo do l = 1, llm vcov(iip1, j, l) = vcov(1, j, l) enddo enddo C Passage aux vents covariants do l = 1, llm do j=1,jjm do i = 1, iip1 vcov(i,j,l) = vcov(i,j,l) * cv (i, j) c vcov(i,j,l) = vcov(i,j,l) enddo enddo enddo C Traitement de l'enthalpie/temperature ierr = cluvdb() ierr = SETNAME(' ','T',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype,lbid, plev, lmdep) size = imdep * jmdep * lmdep * r4 ierr = GETDAT(ecdicdyn, champ3d, size) C je suppose que les niveaux de pression sont numerotes de bas en haut: c psol = 1 c haut = lmdep c Interpolation horizontale do l = lmdep, 1, -1 do j = 1, jmdep do i = 1, imdep champ(imdep*(j-1)+i) = . champ3d(i + (j-1)*imdep + (l-1)*jmdep*imdep) enddo enddo call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) do j = 1, jjp1 do i = 1, iip1 champhor(i, j, (lmdep - l + 1)) = champecrit (i, j) enddo enddo enddo c Interpolation verticale par spline do j=1,jjp1 do i=1,iim c do l=1,lmdep c ax(l)=plev(lmdep - l + 1) c enddo c do l=1,llm c bx(l)=sig_s(l)*psol(i, j) c enddo do l=1,lmdep ay(l)=champhor(i,j,l) enddo call SPLINE(ax,ay,lmdep,1e30,1.e30,yder) do l=1,llm call SPLINT(ax,ay,yder,lmdep,bx(l),by(l)) champ3decr(i,j,l)=by(l) enddo enddo do l = 1, llm champ3decr(iip1, j, l) = champ3decr(1, j, l) enddo enddo C Passage a la temperature potentielle do l = 1, llm do j=1,jjp1 do i = 1, iip1 c temp(i,j,l) = champ3decr(i,j,l) temp(i,j,l) = champ3decr(i,j,l)*cpp/(s(l)* . (psol(i,j)/100.)**kappa) enddo enddo enddo C Traitement de l'humidite ierr = cluvdb() ierr = SETNAME(' ','R',' ',' ',' ') ierr = INQDICT(ecdicdyn, IDRS_GETFIRSTVAR) ierr = GETCDIM(1, dimsource, dimname, dimtitle, dimunits, . dimtype,ibid, dlon, imdep) ierr = GETCDIM(2, dimsource, dimname, dimtitle, dimunits, . dimtype,jbid, dlat, jmdep) ierr = GETCDIM(3, dimsource, dimname, dimtitle, dimunits, . dimtype,lbid, plev, lmdep) size = imdep * jmdep * lmdep * r4 ierr = GETDAT(ecdicdyn, champ3d, size) C je suppose que les niveaux de pression sont numerotes de bas en haut: c psol = 1 c haut = lmdep c Interpolation horizontale do l = lmdep, 1, -1 do j = 1, jmdep do i = 1, imdep champ(imdep*(j-1)+i) = . champ3d(i + (j-1)*imdep + (l-1)*jmdep*imdep) enddo enddo call linearb(imdep, jmdep, dlon, dlat, . iim, jjp1, rlonv, rlatu, . iix, jjx, ix, jx, sx, airnx, icount) call linear(imdep, jmdep, iim, jjp1, . champ, champint, . icount, iix, jjx, ix, jx, sx, airnx) call gr_int_dyn(champint, champecrit, iim, jjp1) do j = 1, jjp1 do i = 1, iip1 champhor(i, j, (lmdep - l + 1)) = champecrit (i, j) enddo enddo enddo c Interpolation verticale par spline do j=1,jjp1 do i=1,iim c do l=1,lmdep c ax(l)=plev(lmdep - l + 1) c enddo c do l=1,llm c bx(l)=sig_s(l)*psol(i, j) c enddo do l=1,lmdep ay(l)=champhor(i,j,l) enddo call SPLINE(ax,ay,lmdep,1e30,1.e30,yder) do l=1,llm call SPLINT(ax,ay,yder,lmdep,bx(l),by(l)) champ3decr(i,j,l)=by(l) enddo enddo do l = 1, llm champ3decr(iip1, j, l) = champ3decr(1, j, l) enddo enddo C Passage au rapport de melange do l = 1, llm do j=1,jjp1 do i = 1, iip1 ttt=temp(i,j,l) if(ttt.gt.233.) then qs=.622*10.**(2.07023-0.0032091*ttt-2484.896/ttt .+3.56654*log10(ttt))/ax(l) else qs=.622*10.**(23.8319-2948.964/ttt-5.028*log10(ttt) .-29810.16*exp(-.0699382*ttt)+25.21935*exp(-2999.924/ttt))/ax(l) endif q(i,j,l)=0.01 *champ3decr(i,j,l)*qs enddo enddo enddo nqllm = 1 nbetat = 1 call writedem(intdicdyn, nqllm, ldrs, time, vcov, ucov, temp, . q, pext, phis, nbetat) ierr = cllun(ecdicdyn) ierr = cllun(intdicdyn) end