Changeset 2227 for trunk/LMDZ.MARS/util/localtime.F90

Timestamp:

Jan 27, 2020, 7:40:05 PM (5 years ago)

Author:

abierjon

Message:

Mars GCM:
Bug fixes in localtime.F90 : 1) Following of the correction by EM (r2215), separation of the "valid_range" and "missing_value" indicators, which prevented localtime to write the missing_value attribute in the output file and was making r2215 useless ; 2) Altitude attributes written in the output file are no more specified by default but are read in input file (important for zrecasted files).
AB+EM

File:

• trunk/LMDZ.MARS/util/localtime.F90 (modified) (12 diffs)

trunk/LMDZ.MARS/util/localtime.F90

@@ -27 +27 @@
 !character (len=1) :: ccopy
 ! ccpy: 'y' or 'n' answer
-integer :: nid,ierr,miss
+
+character (len=50) :: altlong_name,altunits,altpositive
+! altlong_name(): [netcdf] altitude "long_name" attribute
+! altunits(): [netcdf] altitude "units" attribute
+! altpositive(): [netcdf] altitude "positive" attribute
+
+integer :: nid,ierr,miss,validr
 ! nid: [netcdf] file ID #
 ! ierr: [netcdf] subroutine returned error code
@@ -346 +352 @@
         stop
       endif
+! Get altitude attributes to handle files with any altitude type
+ierr=nf_get_att_text(nid,altvar,'long_name',altlong_name)
+ierr=nf_get_att_text(nid,altvar,'units',altunits)
+ierr=nf_get_att_text(nid,altvar,'positive',altpositive)
 
       if (ctllen .ne. 0) then
@@ -489 +499 @@
    ! Initialize output file's lat,lon,alt and time dimensions
      call initiate(filename,lat,lon,alt,ctl,latlen,lonlen,altlen,ctllen,&
+           altlong_name,altunits,altpositive,&
            nout,latdimout,londimout,altdimout,timedimout,timevarout)
 
@@ -602 +613 @@
       ierr = NF_GET_VAR_DOUBLE(nid,varid,var3d)
       miss=NF_GET_ATT_DOUBLE(nid,varid,"missing_value",missing)
-      miss=NF_GET_ATT_DOUBLE(nid,varid,"valid_range",valid_range)
+      validr=NF_GET_ATT_DOUBLE(nid,varid,"valid_range",valid_range)
 #else
       ierr = NF_GET_VAR_REAL(nid,varid,var3d)
       miss=NF_GET_ATT_REAL(nid,varid,"missing_value",missing)
-      miss=NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range)
+      validr=NF_GET_ATT_REAL(nid,varid,"valid_range",valid_range)
 #endif
 
@@ -679 +690 @@
       ! Write "valid_range" and "missing_value" attributes in output file
       if (miss.eq.NF_NOERR) then
-         call missing_value(nout,varidout,valid_range,missing)
+         call missing_value(nout,varidout,validr,miss,valid_range,missing)
       endif
 
@@ -704 +715 @@
 !******************************************************************************
 Subroutine initiate(filename,lat,lon,alt,ctl,latlen,lonlen,altlen,ctllen,&
+                     altlong_name,altunits,altpositive,&
                      nout,latdimout,londimout,altdimout,timedimout,timevarout)
 !==============================================================================
@@ -731 +743 @@
 real, intent(in):: ctl(ctllen)
 ! ctl(): controle
+character (len=*), intent(in) :: altlong_name
+! altlong_name(): [netcdf] altitude "long_name" attribute
+character (len=*), intent(in) :: altunits
+! altunits(): [netcdf] altitude "units" attribute
+character (len=*), intent(in) :: altpositive
+! altpositive(): [netcdf] altitude "positive" attribute
 integer, intent(out):: nout
 ! nout: [netcdf] file ID
@@ -866 +884 @@
 #endif
 
-ierr = NF_PUT_ATT_TEXT (nout,nvarid,"long_name",8,"altitude")
-ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',2,"km")
-ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',2,"up")
+ierr = NF_PUT_ATT_TEXT (nout,nvarid,'long_name',len_trim(adjustl(altlong_name)),adjustl(altlong_name))
+ierr = NF_PUT_ATT_TEXT (nout,nvarid,'units',len_trim(adjustl(altunits)),adjustl(altunits))
+ierr = NF_PUT_ATT_TEXT (nout,nvarid,'positive',len_trim(adjustl(altpositive)),adjustl(altpositive))
 
 ! End netcdf define mode
@@ -921 +939 @@
 !==============================================================================
 ! Purpose:
-! Copy aps(), bps() and phisinit() from input file to outpout file
+! Copy aps(), bps() and phisinit() from input file to output file
 !==============================================================================
 ! Remarks:
@@ -1164 +1182 @@
 end subroutine def_var
 !******************************************************************************
-subroutine  missing_value(nout,nvarid,valid_range,missing)
+subroutine  missing_value(nout,nvarid,validr,miss,valid_range,missing)
 !==============================================================================
 ! Purpose:
@@ -1186 +1204 @@
 integer, intent(in) :: nvarid
 ! varid: [netcdf] variable ID #
+integer, intent(in) :: validr
+! validr : [netcdf] routines return code for "valid_range" attribute
+integer, intent(in) :: miss
+! miss : [netcdf] routines return code for "missing_value" attribute
 real, dimension(2), intent(in) :: valid_range
 ! valid_range(2): [netcdf] "valid_range" attribute (min and max)
@@ -1208 +1230 @@
 
 ! Write valid_range() attribute
-#ifdef NC_DOUBLE
-ierr=NF_PUT_ATT_DOUBLE(nout,nvarid,'valid_range',NF_DOUBLE,2,valid_range)
-#else
-ierr=NF_PUT_ATT_REAL(nout,nvarid,'valid_range',NF_FLOAT,2,valid_range)
-#endif
-
-if (ierr.ne.NF_NOERR) then
-   print*,'missing_value: valid_range attribution failed'
-   print*, NF_STRERROR(ierr)
-   !write(*,*) 'NF_NOERR', NF_NOERR
-   !CALL abort
-   stop ""
+if (validr.eq.NF_NOERR) then
+#ifdef NC_DOUBLE
+  ierr=NF_PUT_ATT_DOUBLE(nout,nvarid,'valid_range',NF_DOUBLE,2,valid_range)
+#else
+  ierr=NF_PUT_ATT_REAL(nout,nvarid,'valid_range',NF_FLOAT,2,valid_range)
+#endif
+
+  if (ierr.ne.NF_NOERR) then
+     print*,'missing_value: valid_range attribution failed'
+     print*, NF_STRERROR(ierr)
+     !write(*,*) 'NF_NOERR', NF_NOERR
+     !CALL abort
+     stop ""
+  endif
 endif
 
 ! Write "missing_value" attribute
-#ifdef NC_DOUBLE
-ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',NF_DOUBLE,1,missing)
-#else
-ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',NF_FLOAT,1,missing)
-#endif
-
-if (ierr.NE.NF_NOERR) then
-   print*, 'missing_value: missing value attribution failed'
-   print*, NF_STRERROR(ierr)
-!    WRITE(*,*) 'NF_NOERR', NF_NOERR
-!    CALL abort
-   stop ""
+if (miss.eq.NF_NOERR) then
+#ifdef NC_DOUBLE
+  ierr= NF_PUT_ATT_DOUBLE(nout,nvarid,'missing_value',NF_DOUBLE,1,missing)
+#else
+  ierr= NF_PUT_ATT_REAL(nout,nvarid,'missing_value',NF_FLOAT,1,missing)
+#endif
+
+  if (ierr.NE.NF_NOERR) then
+     print*, 'missing_value: missing value attribution failed'
+     print*, NF_STRERROR(ierr)
+  !    WRITE(*,*) 'NF_NOERR', NF_NOERR
+  !    CALL abort
+     stop ""
+  endif
 endif