Index: /trunk/LMDZ.GENERIC/README =================================================================== --- /trunk/LMDZ.GENERIC/README (revision 322) +++ /trunk/LMDZ.GENERIC/README (revision 323) @@ -528,2 +528,8 @@ A bug involving the definition of the Planck function boundaries was corrected in sfluxi.F90 and gfluxi.F. + +== 21/10/2011 == EM +- added FF's upgrade of writediagfi. Now, if at runtime there is a diagfi.def + file, it should contain the list of variables (1 per line) than will be put + in the diagfi.nc file. If there is no diagfi.def file, then all variables + are put in the diagfi.nc file (as was the case before). Index: /trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F =================================================================== --- /trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F (revision 322) +++ /trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F (revision 323) @@ -6,5 +6,5 @@ ! 0d (pour un scalaire qui ne depend que du temps : ex : la longitude ! solaire) -! (ou encore 1d, dans le cas de rcm1d, pour sortir une colonne) +! (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne) ! La periode d'ecriture est donnee par ! "ecritphy " regle dans le fichier de controle de run : run.def @@ -21,4 +21,7 @@ ! avant l'ecriture dans diagfi (cf. physiq.F) ! +! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4 +! Oct 2011 Francois: enable having a 'diagfi.def' file to select +! at runtime, which variables to put in file ! ! parametres (input) : @@ -52,32 +55,27 @@ ! Arguments on input: - integer ngrid - character (len=*) :: nom,titre,unite - integer dim - real px(ngrid,llm) + integer,intent(in) :: ngrid + character (len=*),intent(in) :: nom,titre,unite + integer,intent(in) :: dim + real,intent(in) :: px(ngrid,llm) ! Local variables: - real dx3(iip1,jjp1,llm) ! to store a 3D data set - real dx2(iip1,jjp1) ! to store a 2D (surface) data set - real dx1(llm) ! to store a 1D (column) data set - real dx0 - - real date + real*4 dx3(iip1,jjp1,llm) ! to store a 3D data set + real*4 dx2(iip1,jjp1) ! to store a 2D (surface) data set + real*4 dx1(llm) ! to store a 1D (column) data set + real*4 dx0 + + real*4,save :: date REAL phis(ip1jmp1) integer irythme - integer ierr + integer ierr,ierr2 integer iq integer i,j,l,zmax , ig0 - integer zitau - character firstnom*20 - SAVE firstnom - SAVE zitau - SAVE date - data firstnom /'1234567890'/ - data zitau /0/ + integer,save :: zitau=0 + character(len=20),save :: firstnom='1234567890' ! Ajouts @@ -85,9 +83,18 @@ integer :: idim,varid integer :: nid - character (len =50):: fichnom + character(len=*),parameter :: fichnom="diagfi.nc" integer, dimension(4) :: id integer, dimension(4) :: edges,corner + +! Added to use diagfi.def to select output variable + logical,save :: diagfi_def + logical :: getout + integer,save :: n_nom_def + integer :: n + integer,parameter :: n_nom_def_max=99 + character(len=20),save :: nom_def(n_nom_def_max) + logical,save :: firstcall=.true. - +#ifndef MESOSCALE !*************************************************************** !Sortie des variables au rythme voulu @@ -101,13 +108,50 @@ !*************************************************************** +! At very first call, check if there is a "diagfi.def" to use and read it +! ----------------------------------------------------------------------- + IF (firstcall) THEN + firstcall=.false. + + ! Open diagfi.def definition file if there is one: + open(99,file="diagfi.def",status='old',form='formatted', + s iostat=ierr2) + + if(ierr2.eq.0) then + diagfi_def=.true. + write(*,*) "******************" + write(*,*) "Reading diagfi.def" + write(*,*) "******************" + do n=1,n_nom_def_max + read(99,fmt='(a)',end=88) nom_def(n) + write(*,*) 'Output in diagfi: ', trim(nom_def(n)) + end do + 88 continue + if (n.ge.n_nom_def_max) then + write(*,*)"n_nom_def_max too small in writediagfi.F:",n + stop + end if + n_nom_def=n-1 + close(99) + else + diagfi_def=.false. + endif + END IF ! of IF (firstcall) + +! Get out of write_diagfi if there is diagfi.def AND variable not listed +! --------------------------------------------------------------------- + if (diagfi_def) then + getout=.true. + do n=1,n_nom_def + if(trim(nom_def(n)).eq.nom) getout=.false. + end do + if (getout) return + end if ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file ! ------------------------------------------------------------------------ -! (Au tout premier appel de la subroutine durant le run.) - - fichnom="diagfi.nc" - - if (firstnom.eq.'1234567890') then ! .true. for the very first call - ! to this subroutine; now set 'firstnom' +! (at very first call to the subroutine, in accordance with diagfi.def) + + if (firstnom.eq.'1234567890') then ! .true. for the very first valid + ! call to this subroutine; now set 'firstnom' firstnom = nom ! just to be sure, check that firstnom is large enough to hold nom @@ -124,9 +168,9 @@ ierr = nf_def_dim(nid,"Time",NF_UNLIMITED,idim) ! Define the 'Time' variable -#ifdef NC_DOUBLE - ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid) -#else +!#ifdef NC_DOUBLE +! ierr = NF_DEF_VAR (nid, "Time", NF_DOUBLE, 1, idim,varid) +!#else ierr = NF_DEF_VAR (nid, "Time", NF_FLOAT, 1, idim,varid) -#endif +!#endif ! Add a long_name attribute ierr = NF_PUT_ATT_TEXT (nid, varid, "long_name", @@ -149,5 +193,5 @@ if (ngridmx.eq.1) then - ! in rcm1d, for the 1d version of the GCM, iphysiq and irythme + ! in testphys1d, for the 1d version of the GCM, iphysiq and irythme ! are undefined; so set them to 1 iphysiq=1 @@ -182,9 +226,9 @@ ierr= NF_INQ_VARID(nid,"Time",varid) ! Write (append) the new date to the 'Time' array -#ifdef NC_DOUBLE - ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date) -#else +!#ifdef NC_DOUBLE +! ierr= NF_PUT_VARA_DOUBLE(nid,varid,ntime,1,date) +!#else ierr= NF_PUT_VARA_REAL(nid,varid,ntime,1,date) -#endif +!#endif if (ierr.ne.NF_NOERR) then write(*,*) "***** PUT_VAR matter in writediagfi_nc" @@ -247,9 +291,9 @@ edges(3)=llm edges(4)=1 -#ifdef NC_DOUBLE - ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3) -#else +!#ifdef NC_DOUBLE +! ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx3) +!#else ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx3) -#endif +!#endif if (ierr.ne.NF_NOERR) then @@ -306,9 +350,9 @@ -#ifdef NC_DOUBLE - ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) -#else +!#ifdef NC_DOUBLE +! ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx2) +!#else ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx2) -#endif +!#endif if (ierr.ne.NF_NOERR) then @@ -349,9 +393,9 @@ edges(1)=llm edges(2)=1 -#ifdef NC_DOUBLE - ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1) -#else +!#ifdef NC_DOUBLE +! ierr= NF_PUT_VARA_DOUBLE(nid,varid,corner,edges,dx1) +!#else ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx1) -#endif +!#endif if (ierr.ne.NF_NOERR) then @@ -385,9 +429,9 @@ edges(1)=1 -#ifdef NC_DOUBLE - ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0) -#else +!#ifdef NC_DOUBLE +! ierr = NF_PUT_VARA_DOUBLE (nid,varid,corner,edges,dx0) +!#else ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,dx0) -#endif +!#endif if (ierr.ne.NF_NOERR) then write(*,*) "***** PUT_VAR matter in writediagfi" @@ -403,3 +447,4 @@ ierr= NF_CLOSE(nid) +#endif end