Changeset 323 for trunk/LMDZ.GENERIC/libf

Timestamp:

Oct 21, 2011, 11:29:30 AM (13 years ago)

Author:

emillour

Message:

Generic GCM:

• 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).

EM

File:

• trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F (modified) (13 diffs)

trunk/LMDZ.GENERIC/libf/phystd/writediagfi.F

@@ -6 +6 @@
 !  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 +21 @@
 ! 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 +55 @@
 
 ! 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 +83 @@
       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 +108 @@
 !***************************************************************
 
+! 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 +168 @@
          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 +193 @@
 
       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 +226 @@
            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 +291 @@
            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 +350 @@
 
 
-#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 +393 @@
            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 +429 @@
            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 +447 @@
       ierr= NF_CLOSE(nid)
 
+#endif
       end