Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/api.F90
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/api.F90	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/api.F90	(revision 19)
@@ -0,0 +1,1631 @@
+ PROGRAM api
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! API                                                             !
+! Altitude and Pressure Interpolator                              !
+!                                                                 !
+! This program is based on                                        !
+! ------------------------                                        !
+! p_interp v1.0                                                   !
+! http://www.mmm.ucar.edu/wrf/src/p_interp.tar.gz                 !
+! September 2008 - Cindy Bruyere [NCAR, USA]                      !
+!                                                                 !
+! Modifications                                                   !
+! -------------                                                   !
+! - Presentation of the program (cosmetics)                       !
+! - Additional routine and arguments in existing routines         !
+! - Improve memory management                                     ! 
+! - Martian constants + Addition of 'grav' variable               !
+! - Interpolation to height above areoid (MOLA zero datum)        !
+! October 2009 - Aymeric Spiga [The Open University, UK]          !
+! - Interpolation to height above surface                         !
+! - Rotated winds (e.g. for polar projections)                    !
+! November 2009 - AS                                              !
+!                                                                 !
+! Purpose                                                         !
+! -------                                                         !
+!  Program to read wrfout data (possibly several files)           !
+!     and interpolate to pressure or height levels                !
+!  A new NETCDF file is generated with appropriate suffix         !
+!  The program reads namelist.api                                 !
+!                                                                 !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      IMPLICIT NONE
+      INCLUDE 'netcdf.inc'
+
+      !!
+      !! EARTH CONSTANTS
+      !! 
+      !REAL, PARAMETER :: Rd  = 287.04   ! gas constant m2 s-2 K-1
+      !REAL, PARAMETER :: Cp  = 7.*Rd/2. ! r=8.314511E+0*1000.E+0/mugaz
+      !REAL, PARAMETER :: RCP = Rd/Cp
+      !REAL, PARAMETER :: p0  = 100000.
+      !REAL, PARAMETER :: grav = 9.81
+      !REAL, PARAMETER :: tpot0 = 300.
+
+      !
+      ! MARS CONSTANTS
+      ! 
+      REAL, PARAMETER :: Rd  = 192.     ! gas constant m2 s-2 K-1
+      REAL, PARAMETER :: Cp  = 844.6    ! r= 8.314511E+0*1000.E+0/mugaz
+!REAL, PARAMETER :: Rd  = 191.0
+!REAL, PARAMETER :: Cp  = 744.5
+      REAL, PARAMETER :: RCP = Rd/Cp
+      REAL, PARAMETER :: p0  = 610.
+      REAL, PARAMETER :: grav = 3.72
+      REAL, PARAMETER :: tpot0 = 220.   ! reference potential temperature
+
+      !
+      ! VARIABLES
+      !
+      CHARACTER,         ALLOCATABLE, DIMENSION(:,:,:,:) :: text
+      CHARACTER (LEN=31),ALLOCATABLE, DIMENSION(:)       :: dnamei, dnamej
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: input_file_names
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: output_file_names
+      DOUBLE PRECISION,  ALLOCATABLE, DIMENSION(:,:,:,:) :: ddata1, ddata2
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: data1, data2, data3
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_field, pres_out
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_stagU, pres_stagV
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: ght, phb, qv, tk, rh, tpot, u, v, umet, vmet 
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:)   :: psfc
+      REAL,              ALLOCATABLE, DIMENSION(:,:)     :: ter
+      REAL,              ALLOCATABLE, DIMENSION(:,:)     :: longi, lati
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:)   :: longit, latit
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:)   :: interm1, interm2
+      INTEGER,           ALLOCATABLE, DIMENSION(:)       :: dvali, dvalj
+      INTEGER,           ALLOCATABLE, DIMENSION(:,:,:,:) :: idata1, idata2
+      INTEGER,                        DIMENSION(4)       :: start_dims = 1
+      INTEGER,                        DIMENSION(4)       :: dims_in, dims_out
+      INTEGER,                        DIMENSION(6)       :: ishape, jshape
+      CHARACTER (LEN=80)                                 :: cval
+      CHARACTER (LEN=31)                                 :: cname, test_dim_name
+      CHARACTER (LEN=80)                                 :: input_file, output_file, att_text
+      CHARACTER (LEN=250)                                :: path_to_input
+      CHARACTER (LEN=250)                                :: path_to_output
+      CHARACTER (LEN=250)                                :: input_name
+      CHARACTER (LEN=250)                                :: output_name, tmp_name
+      CHARACTER (LEN=10)                                 :: option
+      CHARACTER (LEN=132)                                :: command
+      CHARACTER (LEN=20)                                 :: process, dummy
+      CHARACTER (LEN=2000)                               :: fields, process_these_fields
+      REAL, DIMENSION(99)                                :: interp_levels
+      REAL                                               :: rval
+      REAL                                               :: MISSING=1.e36
+      REAL                                               :: truelat1, truelat2, stand_lon
+      INTEGER                                            :: map_proj
+      INTEGER                                            :: LINLOG = 1
+      INTEGER                                            :: interp_method=1
+      INTEGER                                            :: extrapolate=0
+      INTEGER                                            :: ncid, mcid, rcode
+      INTEGER                                            :: idm, ndims, nvars, natt, ngatts
+      INTEGER                                            :: nunlimdimid
+      INTEGER                                            :: i, ii, j, jj, ix, iy, iweg, isng, ibtg
+      INTEGER                                            :: ivar, jvar
+      INTEGER                                            :: times_in_file
+      INTEGER                                            :: ilen, itype, ival, na, funit, ios
+      INTEGER                                            :: num_metgrid_levels
+      INTEGER                                            :: number_of_input_files
+      INTEGER                                            :: ierr, loop, loslen, strlen, lent
+      INTEGER                                            :: is_there
+      INTEGER                                            :: kk
+      LOGICAL                                            :: is_used
+      LOGICAL                                            :: debug=.FALSE.
+      LOGICAL                                            :: interpolate=.FALSE.
+      LOGICAL                                            :: unstagger_grid=.FALSE.
+      LOGICAL                                            :: fix_meta_stag=.FALSE.
+      LOGICAL                                            :: bit64=.FALSE.
+      LOGICAL                                            :: first=.TRUE.
+      LOGICAL                                            :: oldvar=.FALSE.              
+
+      !
+      ! NAMELISTS 
+      !
+      NAMELIST /io/ path_to_input, input_name, path_to_output, output_name, &
+                    process, fields, debug, bit64, oldvar
+      NAMELIST /interp_in/ interp_levels, interp_method, extrapolate, unstagger_grid
+
+      !
+      ! DEFAULT VALUES for VARIABLES
+      !
+      path_to_input   = './'
+      path_to_output  = './'
+      output_name     = ' '
+      interp_levels   = -99999.
+      process         = 'all'
+
+      !
+      ! READ NAMELIST
+      !
+        DO funit=10,100
+           INQUIRE(unit=funit, opened=is_used)
+           IF (.not. is_used) EXIT
+        END DO
+        OPEN(funit,file='namelist.api',status='old',form='formatted',iostat=ios)
+        IF ( ios /= 0 ) STOP "ERROR opening namelist.api"
+        READ(funit,io)
+        READ(funit,interp_in)
+        CLOSE(funit)
+
+      !
+      ! INPUT FILE NAMES
+      !
+        lent = len_trim(path_to_input)
+        IF ( path_to_input(lent:lent) /= "/" ) THEN
+           path_to_input = TRIM(path_to_input)//"/"
+        ENDIF
+        lent = len_trim(path_to_output)
+        IF ( path_to_output(lent:lent) /= "/" ) THEN
+           path_to_output = TRIM(path_to_output)//"/"
+        ENDIF
+        input_name = TRIM(path_to_input)//TRIM(input_name)
+        !
+        ! BUILD a UNIX COMMAND based on "ls" of all of the input files
+        !  
+        loslen = LEN ( command )
+        CALL all_spaces ( command , loslen ) 
+        WRITE ( command , FMT='("ls -1 ",A," > .foo")' ) TRIM ( input_name )
+
+      !
+      ! NUMBER OF INPUTS FILES
+      !  
+        !  We stuck all of the matching files in the ".foo" file.  Now we place the 
+        !  number of the those file (i.e. how many there are) in ".foo1". 
+        CALL SYSTEM ( TRIM ( command ) ) 
+        CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
+        !  Read the number of files.
+        OPEN (FILE   = '.foo1'       , &
+              UNIT   = 112           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+        READ ( 112 , * ) number_of_input_files
+        CLOSE ( 112 )
+        !  If there are zero files, we are toast.
+        IF ( number_of_input_files .LE. 0 ) THEN
+           print*, ' Oops, we need at least ONE input file for the program to read.'
+           print*, '       Make sure you have the path, and name file(s) correct,'
+           print*, '       including wild characters if needed.'
+           STOP
+        END IF
+
+      !
+      ! GET FILENAMES IN THE PROGRAM  
+      !
+        !  Allocate space for this many files.
+        ALLOCATE (  input_file_names(number_of_input_files) , STAT=ierr )
+        ALLOCATE ( output_file_names(number_of_input_files) , STAT=ierr )
+        !  Did the allocate work OK?
+        IF ( ierr .NE. 0 ) THEN
+           print*, ' tried to allocate ', number_of_input_files, ' input files, (look at ./foo)'
+           STOP
+        END IF
+        !  Initialize all of the file names to blank.
+          input_file_names = '                                                  ' // &
+                             '                                                  ' // &
+                             '                                '
+         output_file_names = '                                                  ' // &
+                             '                                                  ' // &
+                             '                                '
+        !  Open the file that has the list of filenames.
+        OPEN (FILE   = '.foo'        , &
+              UNIT   = 111           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+        !  Read all of the file names and store them - define output file name.
+        LINLOG = interp_method
+        DO loop = 1 , number_of_input_files
+           READ ( 111 , FMT='(A)' ) input_file_names(loop)
+           IF ( output_name == ' ' ) THEN
+              ilen = INDEX(TRIM(input_file_names(loop)),'/',.TRUE.) 
+              output_file_names(loop) = TRIM(path_to_output)//input_file_names(loop)(ilen+1:)
+              IF ( LINLOG .le. 2 ) output_file_names(loop) = TRIM(output_file_names(loop))//"_p"
+              IF ( LINLOG  ==  3 ) output_file_names(loop) = TRIM(output_file_names(loop))//"_z"
+              IF ( LINLOG  ==  4 ) output_file_names(loop) = TRIM(output_file_names(loop))//"_zabg"
+           ELSE
+              IF ( number_of_input_files == 1 ) THEN
+                 output_file_names(loop) = TRIM(path_to_output)//TRIM(output_name)
+              ELSE
+                 write(tmp_name,'(A,A,"_",I4.4)') TRIM(path_to_output), TRIM(output_name), loop
+                 output_file_names(loop) = tmp_name
+              ENDIF
+           ENDIF
+        END DO
+        CLOSE ( 112 )
+        print*, " " 
+        !   We clean up our own messes.
+        CALL SYSTEM ( '/bin/rm -f .foo'  )
+        CALL SYSTEM ( '/bin/rm -f .foo1' )
+
+      !
+      ! LIST OF FIELD WANTED for OUTPUT  
+      !
+        ! Do we have a list of field that we want on output?
+!        process_these_fields = ','
+!!!! ICI CHAMPS SORTIS PAR DEFAULT
+!!!! ICI CHAMPS SORTIS PAR DEFAULT
+!!!! ICI CHAMPS SORTIS PAR DEFAULT 
+        process_these_fields = ',Times,XLAT,XLONG,' !! les premiere et derniere virgules sont importantes
+!!!! ICI CHAMPS SORTIS PAR DEFAULT
+!!!! ICI CHAMPS SORTIS PAR DEFAULT
+!!!! ICI CHAMPS SORTIS PAR DEFAULT
+        IF ( INDEX(process,'list') /= 0) THEN
+          DO i = 1 , len(fields)
+            IF (fields(i:i) /= ' ' ) THEN
+              process_these_fields = trim(process_these_fields)//fields(i:i)
+            ENDIF
+          END DO
+          process_these_fields = trim(process_these_fields)//","
+        END IF
+
+      !
+      ! HELLO to WORLD  
+      !
+      write(6,*) 
+      write(6,*) "##############################################################"
+      write(6,'(A,i4,A)') " RUNNING api on ", number_of_input_files, " file(s)."
+      write(6,*) 
+      write(6,'(A,$)') " A) INTERPOLATION METHOD: "
+      IF ( LINLOG == 1 ) write(6,*) "  Pressure - linear in p"
+      IF ( LINLOG == 2 ) write(6,*) "  Pressure - linear in log p"
+      IF ( LINLOG == 3 ) write(6,*) "  Height above areoid (MOLA zero datum)"
+      IF ( LINLOG == 4 ) write(6,*) "  Height above surface"
+      write(6,'(A,$)') " B) VERTICAL EXTRAPOLATION: "
+      IF (extrapolate == 0) write(6,*) "  BELOW GROUND and ABOVE model top will be set to missing values "
+      IF (extrapolate == 1) write(6,*) "  BELOW GROUND will be extrapolated and ABOVE model top will be set to values at model top"
+      write(6,'(A,$)') " C) HORIZONTAL GRID: "
+      IF (.not. unstagger_grid) write(6,*) "  Data will be output on C-grid " 
+      IF (unstagger_grid) write(6,*) "  Data will be output on unstaggered grid "
+
+      !
+      ! GET LEVELS (pressure or altitude) TO INTERPOLATE TO
+      !
+      write(6,*)
+      IF ( LINLOG .le. 2 ) write(6,*) "INTERPOLATING TO PRESSURE LEVELS: "
+      IF ( LINLOG  ==  3 ) write(6,*) "INTERPOLATING TO ALTITUDE LEVELS: "
+      IF ( LINLOG  ==  4 ) write(6,*) "INTERPOLATING TO ABG LEVELS: "
+      num_metgrid_levels = 0
+      DO
+        IF (interp_levels(num_metgrid_levels+1) == -99999.) EXIT
+        num_metgrid_levels = num_metgrid_levels + 1
+        if (mod(num_metgrid_levels,8) /= 0 )write(6,'(f8.3,$)') interp_levels(num_metgrid_levels)
+        if (mod(num_metgrid_levels,8) == 0 )write(6,'(f8.3)') interp_levels(num_metgrid_levels)
+        IF ( LINLOG .le. 2 ) interp_levels(num_metgrid_levels) = interp_levels(num_metgrid_levels) * 100.0   !!! Pa
+        IF ( LINLOG .gt. 2 ) interp_levels(num_metgrid_levels) = interp_levels(num_metgrid_levels) * 1000.0  !!! km
+      END DO
+      write(6,*)
+      write(6,*)
+
+      !
+      ! LOOP on FILES
+      !
+      DO loop = 1, number_of_input_files
+
+        IF (debug) write(6,*) "##############################################################"
+        input_file  = input_file_names(loop)
+        output_file = output_file_names(loop)
+
+        IF ( .not. debug ) write(6,*) " Output will be written to: ",trim(output_file)
+
+        IF (debug) THEN
+          write(6,*) " INPUT FILE:         ",trim(input_file)
+          write(6,*) " OUTPUT FILE:        ",trim(output_file)
+          write(6,*) "  "
+        ENDIF
+
+      !
+      ! OPEN INPUT AND OUTPUT FILE
+      !
+        rcode = nf_open(input_file, 0, ncid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        if (bit64) then
+          rcode = nf_create(output_file, NF_64BIT_OFFSET, mcid)
+        else
+          rcode = nf_create(output_file, 0, mcid)
+        endif
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+
+      !
+      ! GET BASIC INFORMATION ABOUT THE FILE
+      ! most important 
+      !   ndims:  number of dimensions
+      !   nvars:  number of variables
+      !   ngatts: number of global attributes
+        rcode = nf_inq(ncid, ndims, nvars, ngatts, nunlimdimid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        IF (debug) THEN
+          write(6,*) ' INPUT file has = ',ndims, ' dimensions, '
+          write(6,*) '                  ',nvars, ' variables, and '      
+          write(6,*) '                  ',ngatts,' global attributes '
+          write(6,*) "  "
+        ENDIF
+        rcode = nf_get_att_int (ncid, nf_global, 'WEST-EAST_GRID_DIMENSION', iweg)
+        rcode = nf_get_att_int (ncid, nf_global, 'SOUTH-NORTH_GRID_DIMENSION', isng)
+        rcode = nf_get_att_int (ncid, nf_global, 'BOTTOM-TOP_GRID_DIMENSION', ibtg)
+
+      !  
+      ! ALLOCATE SOME VARIABLES
+      !
+        IF (ALLOCATED(dnamei)) deallocate(dnamei)
+            ALLOCATE (dnamei(20))
+        IF (ALLOCATED(dnamej)) deallocate(dnamej)
+            ALLOCATE (dnamej(20))
+        IF (ALLOCATED(dvali)) deallocate(dvali)
+            ALLOCATE (dvali(20))
+        IF (ALLOCATED(dvalj)) deallocate(dvalj)
+            ALLOCATE (dvalj(20))
+
+      !      
+      ! READ ALL DIMS FROM INPUT FILE AND CREATE SOME DIMS FOR OUTPUT FILE
+      !
+        j = 0
+        DO i = 1, ndims
+          rcode = nf_inq_dim(ncid, i, dnamei(i), dvali(i))
+          IF ( dnamei(i) == "Time" ) THEN
+            j = j + 1
+            dnamej(j) = dnamei(i)
+            dvalj(j) = dvali(i)
+            rcode = nf_def_dim(mcid, dnamej(j), NF_UNLIMITED, j)
+            times_in_file  = dvali(i)
+          ENDIF 
+        ENDDO
+        !!! Create the new height/pressure dims
+        j = j + 1
+        IF ( LINLOG .le. 2 ) THEN 
+              dnamej(j) = 'pressure' 
+              dvalj(j) = num_metgrid_levels
+        ELSE IF ( LINLOG .eq. 3 ) THEN 
+              dnamej(j) = 'altitude'
+              dvalj(j) = num_metgrid_levels
+        ELSE 
+              dnamej(j) = 'altitude_abg'
+              dvalj(j) = num_metgrid_levels
+        ENDIF
+        rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+
+      !
+      ! DEALING WITH THE GLOBAL ATTRIBUTES
+      !
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) " OUTPUT FILE attributes:"
+        ENDIF
+        do i = 1, ngatts
+          rcode = nf_inq_attname(ncid, nf_global, i,    cname)
+          rcode = nf_inq_atttype(ncid, nf_global, cname, itype)
+          rcode = nf_inq_attlen (ncid, nf_global, cname, ilen)
+         if ( itype .eq. 2 ) then        ! characters
+            rcode = nf_get_att_text (ncid, nf_global, cname, cval)
+            if(cname(1:5) .eq. 'TITLE') then
+               IF ( LINLOG .le. 2 ) THEN
+               cval = cval(1:ilen)//" - ON PRES LEVELS"
+               ELSE
+               cval = cval(1:ilen)//" - ON z LEVELS"
+               ENDIF
+               ilen = len_trim(cval)
+            endif
+            IF (debug) &
+            write(6,'("     i = ",i2," : ",A," = ",A)') &
+                    i,cname,cval(1:ilen)
+            rcode = nf_put_att_text(mcid, nf_global, cname, ilen,&
+                      cval(1:ilen))
+          elseif ( itype .eq. 4 ) then     ! integers
+            rcode = nf_get_att_int (ncid, nf_global, cname, ival)
+            IF ( INDEX(cname,'BOTTOM-TOP_PATCH') == 0 ) THEN
+               IF (cname .eq. 'BOTTOM-TOP_GRID_DIMENSION') ival = num_metgrid_levels
+               IF (debug) &
+                   write(6,'("     i = ",i2," : ",A," = ",i7)') &
+                       i,cname,ival        
+               rcode = nf_put_att_int(mcid, nf_global, cname, itype,&
+                         ilen, ival)
+             ENDIF
+            IF (cname .eq. 'MAP_PROJ') map_proj = ival 
+           elseif ( itype .eq. 5 ) then    ! real
+            rcode = nf_get_att_real (ncid, nf_global, cname, rval)
+            IF (debug) &
+               write(6,'("     i = ",i2," : ",A," = ",G18.10E2)') &
+                    i,cname,rval
+               rcode = nf_put_att_real(mcid, nf_global, cname, itype,&
+                      ilen, rval)
+            IF (cname .eq. 'TRUELAT1') truelat1 = rval
+            IF (cname .eq. 'TRUELAT2') truelat2 = rval
+            IF (cname .eq. 'STAND_LON') stand_lon = rval
+          end if
+        enddo
+       rcode = nf_enddef(mcid)
+
+      ! 
+      ! WE NEED SOME BASIC FIELDS
+      !
+      ! --> P_TOP
+      !
+      IF ( LINLOG .le. 2 ) THEN
+         IF ( DEBUG ) PRINT *, 'P_TOP'     
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(times_in_file,1,1,1))
+         rcode = nf_inq_varid    ( ncid, "P_TOP", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         IF ( first ) THEN
+            IF ( extrapolate == 1 .AND. &
+                 (data1(1,1,1,1)-interp_levels(num_metgrid_levels)) > 0.0 ) THEN
+               write(6,*)
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+               write(6,*) " WARNING: Highest requested pressure level is above PTOP."
+               write(6,'(A,F7.2,A)') "           Use all pressure level data above", data1(1,1,1,1)*.01, " mb"
+               write(6,*) "          with caution."
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+            ENDIF
+            first = .FALSE.
+         ENDIF
+         deallocate (data1)
+      ENDIF   
+      !
+      ! --> INTERPOLATION LEVELS
+      !
+         IF (ALLOCATED(pres_out)) deallocate(pres_out)
+         allocate (pres_out(iweg-1, isng-1, num_metgrid_levels, times_in_file))
+         do i = 1, num_metgrid_levels
+           pres_out (:,:,i,:) = interp_levels(i)
+         enddo
+      !
+      ! --> LONGITUDES + everything for ROTATED WINDS
+      !
+      IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'uvmet') /= 0 ) THEN   
+        IF (ALLOCATED(longi)) deallocate(longi)
+           IF (ALLOCATED(longit)) deallocate(longit)
+           allocate (longi(iweg-1, isng-1))
+           allocate (longit(iweg-1, isng-1, times_in_file))
+           IF ( DEBUG ) PRINT *, 'LONGITUDE' 
+           rcode = nf_inq_varid    ( ncid, "XLONG", i )
+           rcode = nf_get_var_real ( ncid, i, longit )
+           longi = longit(:,:,1)
+           deallocate(longit)
+        IF (ALLOCATED(lati)) deallocate(lati)
+           IF (ALLOCATED(latit)) deallocate(latit)
+           allocate (lati(iweg-1, isng-1))
+           allocate (latit(iweg-1, isng-1, times_in_file))
+           IF ( DEBUG ) PRINT *, 'LATITUDE' 
+           rcode = nf_inq_varid    ( ncid, "XLAT", i )
+           rcode = nf_get_var_real ( ncid, i, latit )
+           lati = latit(:,:,1)
+           deallocate(latit)
+        IF (ALLOCATED(u))       deallocate(u)
+        IF (oldvar) THEN
+           allocate (u      (iweg,   isng-1, ibtg-1, times_in_file ))
+           IF ( DEBUG ) PRINT *, 'U COMPONENT'
+           rcode = nf_inq_varid    ( ncid, "U", i )
+           rcode = nf_get_var_real ( ncid, i, u )
+        ELSE
+           allocate (u      (iweg-1, isng-1, ibtg-1, times_in_file ))
+           IF ( DEBUG ) PRINT *, 'UAVE COMPONENT'
+           rcode = nf_inq_varid    ( ncid, "UAVE", i )
+           rcode = nf_get_var_real ( ncid, i, u )
+        ENDIF
+        IF (ALLOCATED(v))       deallocate(v)
+           IF (oldvar) THEN
+           allocate (v      (iweg-1, isng,   ibtg-1, times_in_file ))
+           IF ( DEBUG ) PRINT *, 'V COMPONENT'
+           rcode = nf_inq_varid    ( ncid, "V", i )
+           rcode = nf_get_var_real ( ncid, i, v )
+        ELSE
+           allocate (v      (iweg-1, isng-1, ibtg-1, times_in_file ))
+           IF ( DEBUG ) PRINT *, 'VAVE COMPONENT'
+           rcode = nf_inq_varid    ( ncid, "VAVE", i )
+           rcode = nf_get_var_real ( ncid, i, v )
+        ENDIF
+        IF (ALLOCATED(umet))    deallocate(umet)
+           allocate (umet   (iweg-1, isng-1, ibtg-1, times_in_file ))
+        IF (ALLOCATED(vmet))    deallocate(vmet)
+           allocate (vmet   (iweg-1, isng-1, ibtg-1, times_in_file ))
+        IF (ALLOCATED(interm1)) deallocate(interm1)
+           allocate (interm1(iweg-1, isng-1, ibtg-1 ))
+        IF (ALLOCATED(interm2)) deallocate(interm2)
+           allocate (interm2(iweg-1, isng-1, ibtg-1 ))
+        IF ( DEBUG ) PRINT *, 'ROTATE WINDS'
+        write(6,*) "  Data will be output on unstaggered grid "
+        do kk = 1, times_in_file
+         IF ( DEBUG ) print *, kk
+         IF (oldvar) THEN
+           interm1(1:iweg-1,:,:) = ( u(1:iweg-1,:,:,kk) + u(2:iweg,:,:,kk) ) * .5
+           interm2(:,1:isng-1,:) = ( v(:,1:isng-1,:,kk) + v(:,2:isng,:,kk) ) * .5
+         ELSE
+           interm1(1:iweg-1,:,:) = u(1:iweg-1,:,:,kk) 
+           interm2(:,1:isng-1,:) = v(:,1:isng-1,:,kk) 
+         ENDIF
+         if (unstagger_grid) map_proj=3 !!! AS: unstagger_grid=T makes the program to put unstaggered U and V in uvmet 
+         CALL calc_uvmet( interm1, interm2, umet(:,:,:,kk), vmet(:,:,:,kk),  &
+                    truelat1, truelat2, stand_lon, map_proj, longi, lati, iweg-1, isng-1, ibtg-1 )
+        enddo
+        deallocate(lati)
+        deallocate(longi)
+        deallocate(u) 
+        deallocate(v)
+        deallocate(interm1)
+        deallocate(interm2)
+      ENDIF
+
+      !   
+      ! --> GEOPOTENTIAL HEIGHT (in mode 1-2, no need if geopotential is not requested)
+      !
+      IF ( LINLOG .gt. 2 .OR. INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'GHT') /= 0 ) THEN
+         IF ( DEBUG ) PRINT *, 'GEOPOTENTIAL'
+         !IF (ALLOCATED(ght)) deallocate(ght)
+         !allocate (ght(iweg-1, isng-1, ibtg-1, times_in_file))
+         IF (ALLOCATED(phb)) deallocate(phb)
+         allocate (phb(iweg-1, isng-1, ibtg, times_in_file ))
+                   !         IF (ALLOCATED(data1)) deallocate(data1)
+                   !         allocate (data1(iweg-1, isng-1, ibtg, times_in_file ))
+                   !         rcode = nf_inq_varid    ( ncid, "PH", i )
+                   !         rcode = nf_get_var_real ( ncid, i, data1 )
+                   !         rcode = nf_inq_varid    ( ncid, "PHB", i )
+                   !         rcode = nf_get_var_real ( ncid, i, phb )
+                   !         data1 = (data1 + phb) 
+                   !         ght(:,:,1:ibtg-1,:) = ( data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:) )*.5
+                   !         deallocate (data1)
+         rcode = nf_inq_varid    ( ncid, "PHTOT", i )
+         rcode = nf_get_var_real ( ncid, i, phb )
+         !ght(:,:,1:ibtg-1,:) = phb(:,:,1:ibtg-1,:)   !! costly in memory !!
+         !deallocate (phb)
+      ENDIF
+      !   
+      ! --> PRESSURE (in mode 3-4, no need if regular temperature is not requested) 
+      !
+      IF ( LINLOG .le. 2 .OR. INDEX(process,'all') /= 0 &
+                .OR. INDEX(process_these_fields,'tk') /= 0 &
+                .OR. INDEX(process_these_fields,'tpot') /= 0 ) THEN
+         IF ( DEBUG ) PRINT *, 'PRESSURE'     
+         IF (ALLOCATED(pres_field)) deallocate(pres_field)
+         allocate (pres_field(iweg-1, isng-1, ibtg-1, times_in_file ))
+                !         IF (ALLOCATED(data1)) deallocate(data1)
+                !         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+                !         rcode = nf_inq_varid    ( ncid, "P", i )
+                !         rcode = nf_get_var_real ( ncid, i, pres_field )
+                !         rcode = nf_inq_varid    ( ncid, "PB", i )
+                !         rcode = nf_get_var_real ( ncid, i, data1 )
+                !         pres_field = pres_field + data1
+         rcode = nf_inq_varid    ( ncid, "PTOT", i )
+         rcode = nf_get_var_real ( ncid, i, pres_field )
+                !         deallocate (data1)
+       !
+       ! --> REGULAR and POTENTIAL TEMPERATURE
+       ! 
+         IF ( DEBUG ) PRINT *, 'TEMP'
+         IF (ALLOCATED(tpot)) deallocate(tpot)
+         allocate (tpot(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (oldvar) THEN 
+            rcode = nf_inq_varid    ( ncid, "T", i )
+            rcode = nf_get_var_real ( ncid, i, tpot )
+            tpot = tpot + tpot0
+         ELSE
+            rcode = nf_inq_varid    ( ncid, "TAVE", i )
+            rcode = nf_get_var_real ( ncid, i, tpot )
+         ENDIF
+         IF ( LINLOG .le. 2 .OR. INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'tk') /= 0 ) THEN      
+           IF (ALLOCATED(tk)) deallocate(tk)
+           allocate (tk(iweg-1, isng-1, ibtg-1, times_in_file ))
+           tk = tpot * ( pres_field / p0 )**RCP
+         ENDIF
+         IF (INDEX(process_these_fields,'tpot') == 0 .AND. INDEX(process,'all') == 0) deallocate(tpot)  
+       ENDIF  
+       !
+       ! --> SURFACE PRESSURE
+       ! 
+       IF ( LINLOG .le. 2 ) THEN
+         IF ( DEBUG ) PRINT *, 'PSFC'      
+         IF (ALLOCATED(psfc)) deallocate(psfc)
+         allocate (psfc(iweg-1, isng-1, times_in_file ))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "PSFC", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         psfc(:,:,:) = data1(:,:,1,:)
+         deallocate (data1)
+       ENDIF
+       !
+       ! --> TOPOGRAPHY
+       ! 
+       IF ( LINLOG .ne. 3 ) THEN
+         IF ( DEBUG ) PRINT *, 'TOPO'      
+         IF (ALLOCATED(ter)) deallocate(ter)
+         allocate (ter(iweg-1, isng-1))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "HGT", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         ter(:,:) = data1(:,:,1,1)
+         IF ( LINLOG .ne. 4 ) deallocate (data1)
+       ENDIF  
+
+                 !         IF (ALLOCATED(qv)) deallocate(qv)
+                 !         allocate (qv(iweg-1, isng-1, ibtg-1, times_in_file ))
+                 !         rcode = nf_inq_varid    ( ncid, "QVAPOR", i )
+                 !         rcode = nf_get_var_real ( ncid, i, qv )
+                 !
+                 ! NOT SUITABLE for MARS
+                 !
+                 !         IF (ALLOCATED(rh)) deallocate(rh)
+                 !         allocate (rh(iweg-1, isng-1, ibtg-1, times_in_file ))
+                 !         IF (ALLOCATED(data1)) deallocate(data1)
+                 !         IF (ALLOCATED(data2)) deallocate(data2)
+                 !         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+                 !         allocate (data2(iweg-1, isng-1, ibtg-1, times_in_file ))
+                 !         data1 = 10.*0.6112*exp(17.67*(tk-273.16)/(TK-29.65))
+                 !         data2 = 0.622*data1/(0.01 * pres_field -  (1.-0.622)*data1)
+                 !         rh    = 100.*AMAX1(AMIN1(qv/data2,1.0),0.0)
+                 !         deallocate (data1)
+                 !         deallocate (data2)
+       !   
+       ! --> USEFUL for INTERPOLATION
+       !
+           !!! at that point pres_field is not used for calculation anymore
+           !!! it is used to set the initial coordinate for interpolation
+           IF ( LINLOG == 3) THEN
+                   IF (ALLOCATED(pres_field)) deallocate(pres_field)
+                   allocate ( pres_field(iweg-1, isng-1, ibtg-1, times_in_file) )
+                   pres_field = phb(:,:,1:ibtg-1,:) / grav
+           ENDIF
+           IF ( LINLOG == 4) THEN
+                   IF (ALLOCATED(pres_field)) deallocate(pres_field)
+                   allocate ( pres_field(iweg-1, isng-1, ibtg-1, times_in_file))
+                DO kk = 1, ibtg-1
+                   pres_field(:,:,kk,:) = - data1(:,:,1,:) + phb(:,:,kk,:) / grav
+                ENDDO
+                   deallocate (data1)
+                   PRINT *, pres_field(10,10,:,1)
+           ENDIF
+ 
+
+       IF (ALLOCATED(pres_stagU)) deallocate(pres_stagU)
+       IF (ALLOCATED(pres_stagV)) deallocate(pres_stagV)
+       IF ( DEBUG ) PRINT *, 'STAGGERED COORDINATES'
+           allocate (pres_stagU(iweg, isng-1, ibtg-1, times_in_file ))
+           allocate (pres_stagV(iweg-1, isng, ibtg-1, times_in_file ))
+           pres_stagU(1,:,:,:)        =  pres_field(1,:,:,:)
+           pres_stagU(iweg,:,:,:)     =  pres_field(iweg-1,:,:,:)
+           pres_stagU(2:iweg-1,:,:,:) = (pres_field(1:iweg-2,:,:,:) + pres_field(2:iweg-1,:,:,:))*.5
+           pres_stagV(:,1,:,:)        =  pres_field(:,1,:,:)
+           pres_stagV(:,isng,:,:)     =  pres_field(:,isng-1,:,:)
+           pres_stagV(:,2:isng-1,:,:) = (pres_field(:,1:isng-2,:,:) + pres_field(:,2:isng-1,:,:))*.5
+
+       !-----------------------------
+       !-----------------------------   
+       ! TRAIN FILE 
+       !-----------------------------
+       !-----------------------------   
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) 
+          write(6,*) "FILE variables:"
+        ENDIF
+        jvar = 0
+        loop_variables : DO ivar = 1, nvars
+
+          rcode = nf_inq_var(ncid, ivar, cval, itype, idm, ishape, natt)
+
+          !!! Do we want this variable ?
+                                   !          IF ( trim(cval) == 'P'  .OR. trim(cval) == 'PB' )  CYCLE loop_variables
+                                   !          IF ( trim(cval) == 'PH' .OR. trim(cval) == 'PHB' ) CYCLE loop_variables
+          !IF ( trim(cval) == 'PTOT' )                         CYCLE loop_variables ! PTOT: no
+          IF ( trim(cval) == 'PHTOT' )                        CYCLE loop_variables ! PHTOT: no
+          IF ( trim(cval) == 'T' )                            CYCLE loop_variables ! T: no (tk and tpot calculated above)
+          IF ( unstagger_grid .AND. (INDEX(cval,'_U') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( unstagger_grid .AND. (INDEX(cval,'_V') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( INDEX(process,'all') == 0 ) THEN
+             !!! Only want some variables - see which
+             dummy = ","//trim(cval)//","
+             is_there = INDEX(process_these_fields,trim(dummy))
+             IF ( is_there == 0 ) THEN
+                IF ( debug ) print*,"NOTE: ", trim(cval), " - Not requested"
+                CYCLE loop_variables !!! don't want this one
+             ENDIF
+          ENDIF
+
+          IF ( idm >= 4 .AND. itype == 4 ) THEN
+            print*,"NOTE: We cannot deal with 3D integers - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 6 ) THEN
+            print*,"NOTE: We cannot deal with double precision data - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 2 .OR. itype == 4 .OR. itype == 5 ) THEN
+            !!! OK I know what to do this this
+          ELSE
+            print*,"NOTE: Do not understand this data type ", itype, " skip field."
+            CYCLE loop_variables
+          ENDIF
+
+          !IF ( trim(cval) == 'U' )   cval = 'UU'
+          !IF ( trim(cval) == 'V' )   cval = 'VV'
+          !IF ( trim(cval) == 'T' )   cval = 'TT'
+
+          !!! OK - we want this - lets continue
+          jvar = jvar + 1
+          jshape = 0
+          interpolate = .FALSE.
+          fix_meta_stag = .FALSE.
+          rcode = nf_redef(mcid)
+          DO ii = 1, idm 
+            test_dim_name = dnamei(ishape(ii))
+            IF ( test_dim_name == 'bottom_top' .OR. test_dim_name == 'bottom_top_stag' ) THEN
+                 IF ( test_dim_name == 'bottom_top_stag' ) fix_meta_stag = .TRUE.
+                 IF (LINLOG .le. 2) test_dim_name = 'pressure'
+                 IF (LINLOG .eq. 3) test_dim_name = 'altitude' 
+                 IF (LINLOG .eq. 4) test_dim_name = 'altitude_abg'
+                 interpolate = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'west_east_stag' )   THEN
+               test_dim_name = 'west_east'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'south_north_stag' ) THEN
+               test_dim_name = 'south_north'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            DO jj = 1,j
+              IF ( test_dim_name == dnamej(jj) ) THEN
+                jshape(ii) = jj
+              ENDIF
+            ENDDO
+
+            IF ( jshape(ii) == 0 ) THEN
+              j = j + 1
+              jshape(ii) = j
+              dnamej(j) = dnamei(ishape(ii))
+              dvalj(j) = dvali(ishape(ii))
+              rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+            ENDIF
+          ENDDO
+          rcode = nf_def_var(mcid, cval, itype, idm, jshape, jvar)
+          !print *, 'mcid',   mcid
+          !print *, 'cval',   cval
+          !print *, 'itype',  itype
+          !print *, 'idm',    idm
+          !print *, 'jshape', jshape
+          !print *, 'jvar',   jvar  
+
+          DO na = 1, natt
+             rcode = nf_inq_attname(ncid, ivar, na, cname)
+             IF ( fix_meta_stag .AND. trim(cname) == 'stagger' ) THEN
+                att_text = "-"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSEIF ( fix_meta_stag .AND. trim(cname) == 'coordinates' ) THEN
+                att_text = "XLONG XLAT"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSE
+                rcode = nf_copy_att(ncid, ivar, cname, mcid, jvar)
+             ENDIF
+          ENDDO
+
+          IF ( extrapolate == 0 ) THEN
+            rcode = nf_put_att_real(mcid, jvar, 'missing_value', NF_FLOAT, 1, MISSING )
+          ENDIF
+
+          rcode = nf_enddef(mcid)
+
+!          
+! GET THE DIMS FOR INPUT AND OUTPUT FROM THE SHAPE
+!
+          dims_in  = 1
+          dims_out = 1
+          DO ii = 1,idm
+            dims_in(ii)  = dvali(ishape(ii))
+            dims_out(ii) = dvalj(jshape(ii))
+          ENDDO
+          IF (debug) write(6,*) 'VAR: ',trim(cval)
+          IF (debug) THEN
+            write(6,*) '     DIMS  IN: ',dims_in
+            write(6,*) '     DIMS OUT: ',dims_out
+          ENDIF
+
+!
+! ALLOCATE THE INPUT AND OUTPUT ARRAYS
+! READ THE DATA FROM INPUT FILE
+!
+  IF     (itype == 2) THEN          ! character
+    allocate (text(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+    rcode = nf_get_var_text(ncid, ivar, text)
+    rcode = nf_put_vara_text (mcid, jvar, start_dims, dims_in, text)
+    IF (debug) write(6,*) '     SAMPLE VALUE = ',text(:,1,1,1)
+    deallocate (text)
+ 
+  ELSEIF (itype == 4) THEN          ! integer
+    allocate (idata1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+    rcode = nf_get_var_int(ncid, ivar, idata1)
+    rcode = nf_put_vara_int (mcid, jvar, start_dims, dims_in, idata1)
+    IF (debug) write(6,*) '     SAMPLE VALUE = ',idata1(dims_in(1)/2,dims_in(2)/2,1,1)
+    deallocate (idata1)
+  
+  ELSEIF (itype == 5) THEN          ! real
+     allocate (data1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+     allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+     rcode = nf_get_var_real(ncid, ivar, data1)
+  
+            IF (idm >= 4 .AND. interpolate) THEN  
+               IF (debug) write(6,*) '     THIS IS A FIELD WE NEED TO INTERPOLATE'       
+
+               IF ( dims_in(1) == iweg .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagU, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(2) == isng .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagV, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(1) == iweg .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(2) == isng .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(3) == ibtg ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  IF (debug) PRINT *, 'VERTICAL UNSTAGGERING'
+                  data3(:,:,1:ibtg-1,:) = (data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSE
+                  CALL interp (data2, data1, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), dims_in(3), dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               END IF
+
+               IF (debug) write(6,*) '     SAMPLE VALUE IN  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+               IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+
+            ELSEIF (idm == 3 .AND. unstagger_grid ) THEN  
+               IF ( dims_in(1) == iweg ) THEN
+                  data2(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+               ELSEIF ( dims_in(2) == isng ) THEN
+                  data2(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+               ELSE
+                  data2 = data1
+               ENDIF
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+            ELSE
+                  data2 = data1
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+            ENDIF
+            
+            rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+            !print *, 'mcid ', mcid
+            !print *, 'jvar ', jvar
+            !print *, 'start_dims ', start_dims
+            !print *, 'dims_out ', dims_out
+
+            deallocate (data1)
+            deallocate (data2)
+  
+          ENDIF
+  
+        ENDDO loop_variables
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!! ADDITIONAL VARIABLES !!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+IF ( debug ) print*," "
+IF ( debug ) print*,"Calculating some diagnostics"
+interpolate = .TRUE.
+
+                              !!! NB: what follows is not useful because we'd like diagnostics for each history timestep
+                                      jshape = 0
+                                      DO ii = 1, 4
+                                        IF ( ii == 1 ) test_dim_name = 'west_east'
+                                        IF ( ii == 2 ) test_dim_name = 'south_north'
+                                        IF (( ii == 3 ) .and. (LINLOG .le. 2))  test_dim_name = 'pressure'
+                                        IF (( ii == 3 ) .and. (LINLOG .eq. 3))  test_dim_name = 'altitude'
+                                        IF (( ii == 3 ) .and. (LINLOG .eq. 4))  test_dim_name = 'altitude_abg'
+                                        IF ( ii == 4 ) test_dim_name = 'Time'
+                                        DO jj = 1,j
+                                          IF ( test_dim_name == dnamej(jj) ) THEN
+                                            jshape(ii) = jj
+                                          ENDIF
+                                        ENDDO
+                                        IF ( jshape(ii) == 0 ) THEN
+                                          j = j + 1
+                                          jshape(ii) = j
+                                          dnamej(j) = dnamei(ishape(ii))
+                                          dvalj(j) = dvali(ishape(ii))
+                                          rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+                                        ENDIF
+                                      ENDDO
+                                      dims_in  = 1
+                                      dims_out = 1
+                                      DO ii = 1,4
+                                        dims_out(ii) = dvalj(jshape(ii))
+                                        print *, dims_out(ii)
+                                      ENDDO
+                                      !!! NB: what follows is useful because we'd like diagnostics for each history timestep
+                                      dims_in = dims_out
+
+        !IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'PRES') /= 0 ) THEN
+        !   !!! PRES
+        !   jvar = jvar + 1
+        !   CALL def_var (mcid, jvar, "PRES", 5, 4, jshape, "XZY", "Pressure           ", "Pa", "-", "XLONG XLAT")
+        !   IF (debug) THEN
+        !     write(6,*) 'VAR: PRES'
+        !     write(6,*) '     DIMS OUT: ',dims_out
+        !   ENDIF
+        !   rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, pres_out)
+        !   IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',pres_out(dims_out(1)/2,dims_out(2)/2,1,1)
+        !ENDIF
+
+!
+! EN FAIT IL FAUDRAIT QUE LE jshape SOIT BIEN DEFINI POUR CE QUI SUIT
+!
+
+        !
+        ! OUTPUT REGULAR TEMPERATURE 
+        !
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'tk') /= 0 ) THEN
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "tk  ", 5, 4, jshape, "XZY", "Temperature         ", "K ", "-", "XLONG XLAT", MISSING)
+           IF (debug) THEN
+             write(6,*) 'VAR: tk'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, tk, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+        !
+        ! OUTPUT ROTATED WINDS
+        !
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'uvmet') /= 0 ) THEN
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "Um  ", 5, 4, jshape, "XZY", "U rotated wind      ", "K ", "-", "XLONG XLAT", MISSING)
+           IF (debug) THEN
+             write(6,*) 'VAR: u (rotated)'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, umet, pres_field, interp_levels, psfc, ter, tk, qv,  &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT=',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+           
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "Vm  ", 5, 4, jshape, "XZY", "V rotated wind      ", "K ", "-", "XLONG XLAT", MISSING)
+           IF (debug) THEN
+             write(6,*) 'VAR: v (rotated)'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, vmet, pres_field, interp_levels, psfc, ter, tk, qv,  &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT=',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+        !
+        ! OUTPUT POTENTIAL TEMPERATURE
+        !
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'tpot') /= 0 ) THEN
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "tpot", 5, 4, jshape, "XZY", "Potential Temperature ", "K ", "-", "XLONG XLAT", MISSING)
+           IF (debug) THEN
+             write(6,*) 'VAR: tpot'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, tpot, pres_field, interp_levels, psfc, ter, tk, qv,  &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT =',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+        !
+        ! OUTPUT GEOPOTENTIAL HEIGHT
+        !
+        IF (LINLOG .le. 2) THEN
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'GHT') /= 0 ) THEN
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "GHT ", 5, 4, jshape, "XZY", "Geopotential Height", "m ", "-", "XLONG XLAT", MISSING)
+           IF (debug) THEN
+             write(6,*) 'VAR: GHT'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, phb(:,:,1:ibtg-1,:), pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .TRUE., MISSING)
+           data2 = data2/grav
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+        ELSE
+           PRINT *, 'Geopotential height is actually vertical coordinate'     
+        ENDIF
+
+        !        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'RH') /= 0 ) THEN
+        !           !!! RH
+        !           jvar = jvar + 1
+        !           CALL def_var (mcid, jvar, "RH  ", 5, 4, jshape, "XZY", "Relative Humidity  ", "% ", "-", "XLONG XLAT")
+        !           IF (debug) THEN
+        !             write(6,*) 'VAR: RH'
+        !             write(6,*) '     DIMS OUT: ',dims_out
+        !           ENDIF
+        !           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+        !           CALL interp (data2, rh, pres_field, interp_levels, psfc, ter, tk, qv,   &
+        !                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+        !                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+        !           WHERE ( rh < 0.0 ) 
+        !              rh = 0.0
+        !           ENDWHERE
+        !           WHERE ( rh > 100.0 )
+        !              rh = 100.0
+        !           ENDWHERE
+        !           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+        !           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+        !           deallocate(data2)
+        !        ENDIF
+
+
+!=====================================================================================
+!=====================================================================================
+!
+! VERTICAL COORDINATES
+!
+jvar = jvar + 1
+jshape(:)=0
+jshape(1)=2
+CALL def_var (mcid, jvar, "vert", 5, 1, jshape, " Z ", "Vert. coord.        ","m ", "-", "XLONG XLAT", MISSING)
+start_dims(1)=1
+start_dims(2)=1
+start_dims(3)=1
+start_dims(4)=1
+dims_out(1)=dims_out(3)
+dims_out(2)=1
+dims_out(3)=1
+dims_out(4)=1
+allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+do kk=1,dims_out(1)
+  data2(kk,1,1,1) = interp_levels(kk)
+enddo
+rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+deallocate(data2)
+!=====================================================================================
+!=====================================================================================
+
+
+
+      ! 
+      ! CLOSE FILES ON EXIT
+      !
+        rcode = nf_close(ncid)
+        rcode = nf_close(mcid)
+        write(6,*) 
+      ENDDO 
+
+      !
+      ! WELL...
+      !
+      write(6,*) 
+      write(6,*) "##########################################"
+      write(6,*) " END of API PROGRAM - SUCCESS so far"      
+      write(6,*) "##########################################"
+
+ END PROGRAM api
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+ SUBROUTINE handle_err(rcode)
+    INTEGER rcode
+    write(6,*) 'Error number ',rcode
+    stop
+ END SUBROUTINE
+!---------------------------------------------------------------------
+ SUBROUTINE interp (data_out, data_in, pres_field, interp_levels, psfc, ter, tk, qv, ix, iy, iz, it, &
+                     num_metgrid_levels, LINLOG, extrapolate, GEOPT, MISSING)
+
+     INTEGER                                          :: ix, iy, iz, it
+     INTEGER                                          :: num_metgrid_levels, LINLOG
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: data_out
+     REAL, DIMENSION(ix, iy, iz, it)                  :: data_in, pres_field, tk, qv
+     REAL, DIMENSION(ix, iy, it)                      :: psfc
+     REAL, DIMENSION(ix, iy)                          :: ter
+     REAL, DIMENSION(num_metgrid_levels)              :: interp_levels
+
+     INTEGER                                          :: i, j, itt, k, kk, kin
+     REAL, DIMENSION(num_metgrid_levels)              :: data_out1D
+     REAL, DIMENSION(iz)                              :: data_in1D, pres_field1D
+     INTEGER                                          :: extrapolate
+     REAL                                             :: MISSING
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: N
+     REAL                                             :: sumA, sumN, AVE_geopt
+     LOGICAL                                          :: GEOPT
+
+     N = 1.0
+
+     do itt = 1, it
+     !PRINT *, 'TIME... ', itt, ' in ', iz, ' out ', num_metgrid_levels
+        do j = 1, iy
+        do i = 1, ix
+           data_in1D(:)    = data_in(i,j,:,itt)
+           pres_field1D(:) = pres_field(i,j,:,itt)
+           IF ( LINLOG .le. 2 ) THEN
+             CALL int1D (data_out1D, data_in1D, pres_field1D, interp_levels, iz, num_metgrid_levels, LINLOG, MISSING)
+           ELSE  
+             CALL interp_1d (data_in1D, pres_field1D, iz, data_out1D, interp_levels, num_metgrid_levels, 'z', MISSING)
+                            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                            !interp_1d (data_in1D, pres_field1D, num_metgrid_levels, data_out1D, interp_levels, iz, 'z')
+                            !CALL interp_1d( data_in_1d, z_data_1d, bottom_top_dim, data_out_1d, z_levs, number_of_zlevs, vertical_type)
+                            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+           ENDIF
+           data_out(i,j,:,itt) = data_out1D(:)
+        end do
+        end do
+     end do
+     !PRINT *, 'ok'
+
+     ! Fill in missing values
+     IF ( extrapolate == 0 ) RETURN       !! no extrapolation - we are out of here
+
+
+
+IF ( LINLOG .ge. 0 ) RETURN   !! TEMPORARY: no extrapolation 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! CAUTION BELOW: METHOD NOT ADAPTED TO MARS 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+     !!! MARS MARS MARS
+     !expon=287.04*.0065/9.81
+     expon=192.*.0045/3.72
+
+     ! First find where about 400 hPa is located
+     kk = 0
+     find_kk : do k = 1, num_metgrid_levels
+        kk = k
+        if ( interp_levels(k) <= 40000. ) exit find_kk
+     end do find_kk
+
+     
+     IF ( GEOPT ) THEN     !! geopt is treated different below ground
+
+        do itt = 1, it
+           do k = 1, kk
+              do j = 1, iy
+              do i = 1, ix
+                 IF ( data_out(i,j,k,itt) == MISSING .AND. interp_levels(k) < psfc(i,j,itt) ) THEN
+
+!                We are below the first model level, but above the ground 
+
+!!! MARS MARS
+                    data_out(i,j,k,itt) = ((interp_levels(k) - pres_field(i,j,1,itt))*ter(i,j)*3.72 +  &
+                                           (psfc(i,j,itt) - interp_levels(k))*data_in(i,j,1,itt) ) /   &
+                                          (psfc(i,j,itt) - pres_field(i,j,1,itt))
+
+                 ELSEIF ( data_out(i,j,k,itt) == MISSING ) THEN
+
+!                We are below both the ground and the lowest data level.
+
+!                First, find the model level that is closest to a "target" pressure
+!                level, where the "target" pressure is delta-p less that the local
+!                value of a horizontally smoothed surface pressure field.  We use
+!                delta-p = 150 hPa here. A standard lapse rate temperature profile
+!                passing through the temperature at this model level will be used
+!                to define the temperature profile below ground.  This is similar
+!                to the Benjamin and Miller (1990) method, except that for
+!                simplicity, they used 700 hPa everywhere for the "target" pressure.
+!                Code similar to what is implemented in RIP4
+
+
+!!! MARS MARS MARS
+                    ptarget = (psfc(i,j,itt)*.01) - 1.50 !150.
+                    dpmin=1.e2 !1.e4
+                    kupper = 0
+                    loop_kIN : do kin=iz,1,-1
+                       kupper = kin
+                       dp=abs( (pres_field(i,j,kin,itt)*.01) - ptarget )
+                       if (dp.gt.dpmin) exit loop_kIN
+                       dpmin=min(dpmin,dp)
+                    enddo loop_kIN
+
+                    pbot=max(pres_field(i,j,1,itt),psfc(i,j,itt))
+                    zbot=min(data_in(i,j,1,itt)/3.72,ter(i,j))   !!MARS MARS
+
+                    tbotextrap=tk(i,j,kupper,itt)*(pbot/pres_field(i,j,kupper,itt))**expon
+                    tvbotextrap=virtual(tbotextrap,qv(i,j,1,itt))
+
+                    data_out(i,j,k,itt) = (zbot+tvbotextrap/.0045*(1.-(interp_levels(k)/pbot)**expon))*3.72   !!MARS MARS
+               
+                 ENDIF
+              enddo
+              enddo
+           enddo
+        enddo
+
+
+        !!! Code for filling missing data with an average - we don't want to do this
+        !!do itt = 1, it
+           !!loop_levels : do k = 1, num_metgrid_levels
+              !!sumA = SUM(data_out(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!sumN = SUM(N(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!IF ( sumN == 0. ) CYCLE loop_levels
+              !!AVE_geopt = sumA/sumN
+              !!WHERE ( data_out(:,:,k,itt) == MISSING )
+                 !!data_out(:,:,k,itt) = AVE_geopt
+              !!END WHERE
+           !!end do loop_levels
+        !!end do
+
+     END IF
+     
+     !!! All other fields and geopt at higher levels come here
+     do itt = 1, it
+        do j = 1, iy
+        do i = 1, ix
+          do k = 1, kk
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,1,itt)
+          end do
+          do k = kk+1, num_metgrid_levels
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,iz,itt)
+          end do
+        end do
+        end do
+     end do
+       
+
+ END SUBROUTINE interp 
+!------------------------------------------------------------------------------
+!--------------------------------------------------------
+ SUBROUTINE int1D(xxout, xxin, ppin, ppout, npin, npout, LINLOG, MISSING)
+
+! Modified from int2p - NCL code
+! routine to interpolate from one set of pressure levels
+! .   to another set  using linear or ln(p) interpolation
+!
+! NCL: xout = int2p (pin,xin,pout,linlog)
+! This code was originally written for a specific purpose.
+! .   Several features were added for incorporation into NCL's
+! .   function suite including linear extrapolation.
+!
+! nomenclature:
+!
+! .   ppin   - input pressure levels. The pin can be
+! .            be in ascending or descending order
+! .   xxin   - data at corresponding input pressure levels
+! .   npin   - number of input pressure levels >= 2
+! .   ppout  - output pressure levels (input by user)
+! .            same (ascending or descending) order as pin
+! .   xxout  - data at corresponding output pressure levels
+! .   npout  - number of output pressure levels
+! .   linlog - if abs(linlog)=1 use linear interp in pressure
+! .            if abs(linlog)=2 linear interp in ln(pressure)
+! .   missing- missing data code. 
+
+!                                                ! input types
+      INTEGER   :: npin,npout,linlog,ier
+      real      :: ppin(npin),xxin(npin),ppout(npout)
+      real      :: MISSING       
+     logical                                          :: AVERAGE
+!                                                ! output
+      real      :: xxout(npout)
+      INTEGER   :: j1,np,nl,nin,nlmax,nplvl
+      INTEGER   :: nlsave,np1,no1,n1,n2,nlstrt
+      real      :: slope,pa,pb,pc
+
+! automatic arrays
+      real      :: pin(npin),xin(npin),p(npin),x(npin)
+      real      :: pout(npout),xout(npout)
+
+
+      xxout = MISSING
+      pout  = ppout
+      p     = ppin
+      x     = xxin
+      nlmax = npin
+
+! exact p-level matches
+      nlstrt = 1
+      nlsave = 1
+      do np = 1,npout
+          xout(np) = MISSING
+          do nl = nlstrt,nlmax
+              if (pout(np).eq.p(nl)) then
+                  xout(np) = x(nl)
+                  nlsave = nl + 1
+                  go to 10
+              end if
+          end do
+   10     nlstrt = nlsave
+      end do
+
+      if (LINLOG.eq.1) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      slope = (x(nl)-x(nl+1))/ (p(nl)-p(nl+1))
+                      xout(np) = x(nl+1) + slope* (pout(np)-p(nl+1))
+                  end if
+              end do
+          end do
+      elseif (LINLOG.eq.2) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      pa = log(p(nl))
+                      pb = log(pout(np))
+! special case: in case someone inadvertently enter p=0.
+                      if (p(nl+1).gt.0.d0) then
+                          pc = log(p(nl+1))
+                      else
+                          pc = log(1.d-4)
+                      end if
+
+                      slope = (x(nl)-x(nl+1))/ (pa-pc)
+                      xout(np) = x(nl+1) + slope* (pb-pc)
+                  end if
+              end do
+          end do
+      end if
+
+
+! place results in the return array;
+      xxout = xout
+
+ END SUBROUTINE int1D
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE interp_1d( a, xa, na, b, xb, nb, vertical_type, MISSING)
+
+  implicit none
+
+ ! Arguments
+  integer, intent(in)              :: na, nb
+  real, intent(in), dimension(na)  :: a, xa
+  real, intent(in), dimension(nb)  :: xb
+  real, intent(out), dimension(nb) :: b
+  character (len=1)                :: vertical_type
+
+  !! Local variables
+  real                             :: MISSING                                
+  integer                          :: n_in, n_out
+  real                             :: w1, w2
+  logical                          :: interp
+
+  IF ( vertical_type == 'p' ) THEN
+
+    DO n_out = 1, nb
+
+      b(n_out) = MISSING 
+      interp = .false.
+      n_in = 1
+
+      DO WHILE ( (.not.interp) .and. (n_in < na) )
+        IF( (xa(n_in)   >= xb(n_out)) .and. &
+            (xa(n_in+1) <= xb(n_out))        ) THEN
+          interp = .true.
+          w1 = (xa(n_in+1)-xb(n_out))/(xa(n_in+1)-xa(n_in))
+          w2 = 1. - w1
+          b(n_out) = w1*a(n_in) + w2*a(n_in+1)
+        END IF
+        n_in = n_in +1
+      ENDDO
+
+    ENDDO
+
+  ELSE
+
+    DO n_out = 1, nb
+  
+      b(n_out) = MISSING 
+      interp = .false.
+      n_in = 1
+  
+      DO WHILE ( (.not.interp) .and. (n_in < na) )
+        IF( (xa(n_in)   <= xb(n_out)) .and. &
+            (xa(n_in+1) >= xb(n_out))        ) THEN
+          interp = .true.
+          w1 = (xa(n_in+1)-xb(n_out))/(xa(n_in+1)-xa(n_in))
+          w2 = 1. - w1
+          b(n_out) = w1*a(n_in) + w2*a(n_in+1)
+        END IF
+        n_in = n_in +1
+      ENDDO
+
+    ENDDO
+
+  END IF
+
+  END SUBROUTINE interp_1d
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!------------------------------------------------------------------------------
+ FUNCTION virtual (tmp,rmix)
+!      This function returns virtual temperature in K, given temperature
+!      in K and mixing ratio in kg/kg.
+
+     real                              :: tmp, rmix, virtual
+
+     virtual=tmp*(0.622+rmix)/(0.622*(1.+rmix))
+
+ END FUNCTION virtual
+
+!------------------------------------------------------------------------------
+ SUBROUTINE all_spaces ( command , length_of_char ) 
+
+      IMPLICIT NONE
+
+      INTEGER                                       :: length_of_char
+      CHARACTER (LEN=length_of_char)                :: command
+      INTEGER                                       :: loop
+
+      DO loop = 1 , length_of_char
+         command(loop:loop) = ' '
+      END DO
+
+ END SUBROUTINE all_spaces
+
+!------------------------------------------------------------------------------
+ SUBROUTINE def_var (mcid, jvar, cval, itype, idm, jshape, order, desc, units, stag, coord, missing )
+
+      IMPLICIT NONE
+
+      INCLUDE 'netcdf.inc'
+
+      INTEGER              :: mcid, jvar
+      CHARACTER (LEN =  4) :: cval
+      INTEGER              :: itype, idm
+      REAL, DIMENSION(6)   :: jshape
+      CHARACTER (LEN =  3) :: order
+      CHARACTER (LEN = 19) :: desc
+      CHARACTER (LEN =  2) :: units
+      CHARACTER (LEN =  1) :: stag
+      CHARACTER (LEN = 10) :: coord
+
+      INTEGER            :: rcode, ilen
+      CHARACTER (LEN=30) :: att_text
+
+      REAL               :: missing
+
+
+      IF ( itype == 5 ) THEN
+         rcode = nf_redef(mcid)
+         rcode = nf_def_var(mcid, trim(cval), NF_REAL, idm, jshape, jvar)
+         rcode = nf_put_att_int(mcid, jvar, "FieldType", NF_INT, 1, 104)
+      ENDIF
+
+      att_text = order
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "MemoryOrder", ilen, att_text(1:ilen) )
+
+      att_text = desc
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "description", ilen, att_text(1:ilen) )
+
+      att_text = units
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "units", ilen, att_text(1:ilen) )
+
+      att_text = stag
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "stagger", ilen, att_text(1:ilen) )
+
+      att_text = coord
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "coordinates", ilen, att_text(1:ilen) )
+
+      rcode = nf_put_att_real(mcid, jvar, "missing_value", NF_FLOAT, 1, MISSING )
+
+      rcode = nf_enddef(mcid)
+
+ END SUBROUTINE def_var
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
+!! Diagnostics: U & V on earth coordinates
+  SUBROUTINE calc_uvmet( UUU,           VVV,             &
+                         UUUmet,        VVVmet,          &
+                         truelat1,      truelat2,        &
+                         stand_lon,     map_proj,        &
+                         longi,         lati,            &
+                         west_east_dim, south_north_dim, bottom_top_dim)
+
+  IMPLICIT NONE
+
+  !Arguments
+  integer        :: west_east_dim, south_north_dim, bottom_top_dim
+  real, dimension(west_east_dim,south_north_dim,bottom_top_dim)    :: UUU
+  real, dimension(west_east_dim,south_north_dim,bottom_top_dim)    :: VVV
+  real, dimension(west_east_dim,south_north_dim,bottom_top_dim)    :: UUUmet
+  real, dimension(west_east_dim,south_north_dim,bottom_top_dim)    :: VVVmet
+  real, dimension(west_east_dim,south_north_dim)                   :: longi, lati
+  real :: truelat1, truelat2, stand_lon
+  integer :: map_proj
+
+  !Local
+  integer                                         :: i, j, k
+  real                                            :: cone
+  real, dimension(west_east_dim,south_north_dim)  :: diff, alpha
+
+   real, parameter :: PI = 3.141592653589793
+   real, parameter :: DEG_PER_RAD = 180./PI
+   real, parameter :: RAD_PER_DEG = PI/180.
+
+!  print *, 'map ', map_proj
+  IF ( map_proj .ge. 3 ) THEN                         ! No need to rotate
+    !PRINT *, 'NO NEED TO ROTATE !!!! equivalent to output U,V with unstagger_grid'
+    UUUmet(:,:,:) = UUU
+    VVVmet(:,:,:) = VVV
+  ELSE
+  !END IF
+
+  cone = 1.                                          !  PS
+  IF ( map_proj .eq. 1) THEN                         !  Lambert Conformal mapping
+    IF (ABS(truelat1-truelat2) .GT. 0.1) THEN
+       cone=(ALOG(COS(truelat1*RAD_PER_DEG))-            &
+             ALOG(COS(truelat2*RAD_PER_DEG))) /          &
+       (ALOG(TAN((90.-ABS(truelat1))*RAD_PER_DEG*0.5 ))- &
+        ALOG(TAN((90.-ABS(truelat2))*RAD_PER_DEG*0.5 )) )
+    ELSE
+       cone = SIN(ABS(truelat1)*RAD_PER_DEG )
+    ENDIF
+  END IF
+
+
+  diff = longi - stand_lon
+  DO i = 1, west_east_dim
+  DO j = 1, south_north_dim
+    IF ( diff(i,j) .gt. 180. ) THEN
+      diff(i,j) = diff(i,j) - 360.
+    END IF
+    IF ( diff(i,j) .lt. -180. ) THEN
+      diff(i,j) = diff(i,j) + 360.
+    END IF
+  END DO
+  END DO
+
+!print *, longi(10,10)
+!print *, lati(10,10)
+
+
+  DO i = 1, west_east_dim
+  DO j = 1, south_north_dim
+     IF ( lati(i,j) .lt. 0. ) THEN
+       alpha(i,j) = - diff(i,j) * cone * RAD_PER_DEG
+     ELSE
+       alpha(i,j) = diff(i,j) * cone * RAD_PER_DEG
+     END IF
+  END DO
+  END DO
+
+
+  DO k = 1,bottom_top_dim
+    UUUmet(:,:,k) = VVV(:,:,k)*sin(alpha) + UUU(:,:,k)*cos(alpha)
+    VVVmet(:,:,k) = VVV(:,:,k)*cos(alpha) - UUU(:,:,k)*sin(alpha)
+!print *,UUU(10,10,k), UUUmet(10,10,k)
+!print *,VVV(10,10,k), VVVmet(10,10,k)
+  END DO
+  END IF
+
+  END SUBROUTINE calc_uvmet
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_api
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_api	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_api	(revision 19)
@@ -0,0 +1,52 @@
+#! /bin/bash
+
+#
+# NETCDF should be defined
+#
+
+pgf90 api.F90 -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Mfree -o api
+
+
+#g95 api.F90 -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Wall -Wno=112,141,137,155 -fno-second-underscore -ffree-form -o api
+#g95 api.F90 -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Wall -Wno=112,141,137,155 -ffree-form -o api
+#pgf90 -mcmodel=medium -Mlarge_arrays api.F90 -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Mfree -o p_interp
+
+
+
+
+#!=================================Make Executable============================
+#!  Make executable:
+#!    DEC Alpha
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o p_interp
+#!
+#!   Linux flags
+#!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+#!
+#!   Sun flags
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o p_interp
+#!
+#!   SGI flags
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -freeform  -o p_interp
+#!
+#!   IBM flags 
+#!      xlf p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -qfree=f90  -o p_interp
+#!
+#!   Mac flags (with xlf compiler)
+#!      xlf p_interp.F90 -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o p_interp
+#!
+#!   Mac flags (with g95 compiler)
+#!       g95 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!       -I/usr/local/netcdf/include -ffree-form -o p_interp
+#!
+#!   Mac flags (with pgf90 compiler)
+#!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+#!
+#!============================================================================
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_iowrf
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_iowrf	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_iowrf	(revision 19)
@@ -0,0 +1,6 @@
+#! /bin/bash
+
+### iowrf wrfout_d01_2024-03-20_06:00:00 -box x 50 150 y 50 150
+
+pgf90 iowrf.f -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include  -Mfree  -o iowrf
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_w2g
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_w2g	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/comp_w2g	(revision 19)
@@ -0,0 +1,82 @@
+#! /bin/bash
+
+
+### pb with name of file with pgf90 32 bits
+
+
+
+#
+# NETCDF should be defined
+#
+
+pgf90 w2g.f -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Mfree -o w2g
+
+#g95 w2g.f -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Wall -Wno=137,155 -fno-second-underscore -ffree-form -o w2g
+
+#pgf90 -mcmodel=medium -Mlarge_arrays w2g.f -L$NETCDF/lib -lnetcdf -lm -I$NETCDF/include -Mfree -o w2g
+
+
+#!=================================Make Executable============================
+#!  Make executable:
+#!    DEC Alpha
+#!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o WRFnc2ctl
+#!
+#!   linux flags
+#!      pgf90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -Mfree  -o WRFnc2ctl
+#!
+#!   Sun flags
+#!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o WRFnc2ctl
+#!
+#!   SGI flags 
+#!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -freeform  -o WRFnc2ctl
+#! 
+#!   IBM flags
+#!      xlf WRFnc2ctl.f -L/usr/local/lib32/r4i4 -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -qfree=f90  -o WRFnc2ctl
+#! 
+#!   Mac flags (with xlf compiler)
+#!      xlf WRFnc2ctl.f -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o WRFnc2ctl
+
+
+
+#!=================================Make Executable============================
+#!  Make executable:
+#!    DEC Alpha
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o p_interp
+#!
+#!   Linux flags
+#!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+#!
+#!   Sun flags
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -free  -o p_interp
+#!
+#!   SGI flags
+#!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -freeform  -o p_interp
+#!
+#!   IBM flags 
+#!      xlf p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -qfree=f90  -o p_interp
+#!
+#!   Mac flags (with xlf compiler)
+#!      xlf p_interp.F90 -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o p_interp
+#!
+#!   Mac flags (with g95 compiler)
+#!       g95 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!       -I/usr/local/netcdf/include -ffree-form -o p_interp
+#!
+#!   Mac flags (with pgf90 compiler)
+#!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+#!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+#!
+#!============================================================================
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/do_all
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/do_all	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/do_all	(revision 19)
@@ -0,0 +1,68 @@
+#! /bin/bash
+
+\rm logfile
+\rm *zabg*
+
+#
+# COMPILE
+#
+comp_w2g > logfile 2> logfile
+comp_iowrf > logfile 2> logfile
+comp_api > logfile 2> logfile
+
+#
+# VERTICAL INTERPOLATION -- modify namelist.api
+#
+api > logfile
+
+# FILES COMPLIANT w/ ALL FILESYSTEMS
+#
+ls *_zabg *_p *_z > ye 2> /dev/null
+for fich in $(cat ye) ; do
+  mv $fich $(echo $fich | tr ":" "_") 2> /dev/null
+done
+\rm ye
+
+#
+# GRADS .ctl FILE
+#
+ls *_zabg *_p *_z > ye 2> /dev/null
+for fich in $(cat ye) ; do
+  w2g -i $fich -o $fich > logfile
+done
+\rm ye
+
+#
+# SELECT GRID POINTS
+#
+ls *_zabg *_p *_z > ye 2> /dev/null
+for fich in $(cat ye) ; do
+  #iowrf $fich -box x 50 150 y 50 150 > logfile    ### MODIFIER ICI LA BOX 
+  iowrf $fich -box x 36 108 y 36 108 > logfile
+  #iowrf $fich -box x 5 84 y 5 84 > logfile
+done
+\rm ye
+
+#
+# SELECT LOCAL TIMES
+#
+ls *_zabg-box *_p-box *_z-box > ye 2> /dev/null
+for fich in $(cat ye) ; do
+  #ncrcat -d Time,0,11,1 $fich $fich'-lt'
+  #ncrcat -d Time,8,19,1 $fich $fich'-lt'
+  #ncrcat -d Time,0,7,1 $fich $fich'-lt'  ## nocturne
+  ncrcat -d Time,0,23,1 $fich $fich'-lt'  ## jour complet
+done
+\rm ye
+
+#
+# GRADS .ctl FILE
+#
+ls *_zabg-box* *_p-box* *_z-box* > ye 2> /dev/null
+for fich in $(cat ye) ; do
+  w2g -i $fich -o $fich > logfile
+done
+\rm ye
+
+echo 'END END END' > logfile
+xeyes &
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/iowrf.f
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/iowrf.f	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/iowrf.f	(revision 19)
@@ -0,0 +1,796 @@
+      program iowrf
+!  Program to read/write wrf output. 
+!  OPTION -thin  : It will thin data to the ratio given
+!  OPTION -thina : It will average the fields over a user-specified grid area.
+!  OPTION -A     : De-stagger data
+!  OPTION -box   : Will get data from a user defined box
+!  Updated: January 8, 2008
+!           Add de-staggering option
+!  Updated: Jun 19, 2007
+!           Change time to unlimted on output
+!   Origincal code:
+!           Cindy Bruyere - March 2006
+!           Some code borrowed from Jim Bresch
+!=================================Run Program================================
+!  To extract a box from your input file
+!     iowrf wrfout_file -box x 10 50 y 10 60 [-debug]
+!
+!  To thin your input file down (by picking up corresponding points)
+!     iowrf wrfout_file -thin 3 [-debug]
+!
+!  To thin your input file down (by averaging)
+!     iowrf wrfout_file -thina 3 [-debug]
+!
+!  To de-stagger the data
+!     iowrf wrfout_file -A
+!
+!  To CREATE large 64bit data files
+!     -64bit
+!
+!  To see more options
+!     iowrf -help         
+!
+!  The output will be written to a file with original file name + -box/-thin/-thina/-A
+!
+!=================================Make Executable============================
+!  Make executable:
+!    DEC Alpha
+!      f90 iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o iowrf
+!
+!   linux flags
+!      pgf90 iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o iowrf
+!
+!   Sun flags
+!      f90 iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o iowrf
+!
+!   SGI flags
+!      f90 iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -freeform  -o iowrf
+!
+!   IBM flags (NCAR bluesky - 32bit)
+!      xlf iowrf.f -L/usr/local/lib32/r4i4 -lnetcdf -lm  \
+!      -I/usr/local/include  -qfree=f90  -o iowrf
+!
+!   IBM flags (NCAR bluesky - 64bit)
+!      xlf iowrf.f -L/usr/local/lib64/r4i4 -lnetcdf -lm  \
+!      -I/usr/local/include  -qfree=f90  -o iowrf
+!
+!   IBM flags (NCAR bluevista)   
+!      xlf iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -qfree=f90  -o iowrf
+!
+!   Mac flags (with xlf compiler)
+!      xlf iowrf.f -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o iowrf
+!
+!   Mac flags (with g95 compiler)
+!	g95 iowrf.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!	-I/usr/local/netcdf/include -ffree-form -o iowrf
+!
+!============================================================================
+
+      implicit none
+      INCLUDE 'netcdf.inc'
+      integer  :: jdim
+      parameter (jdim=6)
+      integer ncid, status
+      integer ishape(jdim)
+      integer ishape2(jdim)
+      character cval*50
+      character name*31
+      character (len=31),allocatable, dimension(:)      :: dname
+      integer,           allocatable, dimension(:)       :: dval, dval2
+      real,              allocatable, dimension(:,:,:,:) :: data, data2
+      double precision,  allocatable, dimension(:,:,:,:) :: ddata, ddata2
+      integer,           allocatable, dimension(:,:,:,:) :: idata, idata2
+      character,         allocatable, dimension(:,:,:,:) :: text
+      character omit(10)*80
+      integer             :: start_dims(4)
+      integer             :: dims_in(4), dims_out(4), box_start(3), box_end(3)
+      integer             :: firstS,firstE, secondS,secondE, thirdS,thirdE
+      integer             :: idm, ndims, nvars, natt, ngatts, nunlimdimid, iratio
+      integer             :: i, ii, j, iweg, jweg, isng, jsng, ibtg, jbtg, ix, iy
+      integer             :: i_shape_we, i_shape_sn, i_shape_bt
+      integer             :: i_shape_we_stag, i_shape_sn_stag, i_shape_bt_stag
+      integer             :: ilen, itype, ival, na
+      integer             :: mcid
+      real                :: dx, rval
+      real                :: new_cen
+      real                :: okm
+      character (len=80)  :: input_file, output_file
+      character (len=10)  :: option
+      logical             :: debug=.FALSE.
+      logical             :: x_ave=.FALSE.
+      logical             :: y_ave=.FALSE.
+      logical             :: bit64
+
+      call read_args(input_file,option,iratio,box_start,box_end,bit64,debug)
+      output_file  = trim(input_file)//option
+
+      write(6,*) 
+      write(6,*) "#########################################"
+      write(6,*) "Running IOWRF "
+      write(6,*) 
+      write(6,*) "INPUT FILE:         ",trim(input_file)
+      write(6,*) "OUTPUT FILE:        ",trim(output_file)
+      write(6,*) "OPTION:             ",option    
+
+      IF (debug) THEN
+        if ( option(1:5) == '-thin' ) then           ! used for -thina and -thin
+          write(6,*) "RATIO:             ",iratio    
+        elseif ( option == '-box' )then
+          write(6,*) "BOX START (x y z): ",box_start    
+          write(6,*) "BOX END   (x y z): ",box_end    
+        endif
+      ENDIF
+
+
+! OPEN INPUT AND OUTPUT FILE
+! output_file is input_file_new
+      status = nf_open(input_file, 0, ncid)
+      if (status .ne. nf_noerr) call handle_err(status)
+      if (bit64) then
+        status = nf_create(output_file, NF_64BIT_OFFSET, mcid)
+      else
+        status = nf_create(output_file, 0, mcid)
+      endif
+      if (status .ne. nf_noerr) call handle_err(status)
+
+! GET BASIC INFORMTION ABOUT THE FILE
+! most important 
+!   ndims:  number of dimensions
+!   nvars:  number of variables
+!   ngatts: number of global attributes
+      status = nf_inq(ncid, ndims, nvars, ngatts, nunlimdimid)
+      if (status .ne. nf_noerr) call handle_err(status)
+      IF (debug) THEN
+        write(6,*) 
+        write(6,'(4(A,i4))') ' ndims = ',ndims,'    nvars = ',nvars,'    ngatts = ',ngatts, &
+                   '    nunlimdimid =',nunlimdimid
+        write(6,*) 
+      ENDIF
+
+! ALLOCATE SOME VARIABLES
+      allocate (dval(ndims))
+      allocate(dval2(ndims))
+      allocate(dname(ndims))
+
+! GET SOME BASIC DIMS FROM INPUT_FILE
+      dx = -99.
+      status = nf_get_att_real (ncid, nf_global, 'DX', dx)
+      status = nf_get_att_int (ncid, nf_global, 'WEST-EAST_GRID_DIMENSION', iweg)
+      status = nf_get_att_int (ncid, nf_global, 'SOUTH-NORTH_GRID_DIMENSION', isng)
+      status = nf_get_att_int (ncid, nf_global, 'BOTTOM-TOP_GRID_DIMENSION', ibtg)
+      IF (debug) THEN
+        write(6,*) "BASICS from input file:"
+        write(6,*) "       DX= ", dx
+        write(6,*) "        X= ", iweg
+        write(6,*) "        Y= ", isng
+        write(6,*) "        Z= ", ibtg
+      ENDIF
+      if (dx .lt. 0.) stop 'dx is bad'
+
+! CALCULATE DIMS FOR OUTPUT FILE
+      IF ( option(1:5) == '-thin' ) THEN           ! used for -thina and -thin
+        okm = dx*iratio
+        jweg = int((iweg-1)/iratio) + 1
+        jsng = int((isng-1)/iratio) + 1
+        jbtg = ibtg
+      ELSEIF ( option == '-box' ) THEN
+        okm = dx
+        jweg = iweg
+        jsng = isng
+        jbtg = ibtg
+        if ( box_end(1) .ne. 0 ) jweg = int(box_end(1) - box_start(1)) + 1
+        if ( box_end(2) .ne. 0 ) jsng = int(box_end(2) - box_start(2)) + 1
+        if ( box_end(3) .ne. 0 ) jbtg = int(box_end(3) - box_start(3)) + 1
+      ELSE
+        okm = dx
+        jweg = iweg
+        jsng = isng
+        jbtg = ibtg
+      ENDIF
+      IF (debug) THEN
+        write(6,*) "BASICS for output file:"
+        write(6,*) "       DX= ", okm
+        write(6,*) "        X= ", jweg
+        write(6,*) "        Y= ", jsng
+        write(6,*) "        Z= ", jbtg
+      ENDIF
+      !! We also need to fix the CEN_LAT and CEN_LON later, so get
+      !! the middle of the new domain
+      ix = int((jweg-1)/2.)
+      iy = int((jsng-1)/2.)
+      if ( ix .eq. int(jweg/2.) ) x_ave = .TRUE.
+      if ( iy .eq. int(jsng/2.) ) y_ave = .TRUE.
+      ix = int(jweg/2.)
+      iy = int(jsng/2.)
+
+! READ ALL DIMS FROM INPUT FILE AND CREATE DIMS FOR OUTPUT FILE
+      IF (debug) THEN
+        write(6,*) 
+        write(6,*) "FILE dimensions:"
+      ENDIF
+      i_shape_we      = 0
+      i_shape_sn      = 0
+      i_shape_bt      = 0
+      i_shape_we_stag = 0
+      i_shape_sn_stag = 0
+      i_shape_bt_stag = 0
+
+      do i = 1, ndims
+        status = nf_inq_dim(ncid, i, dname(i), dval(i))
+        dval2(i) = dval(i)
+!       CAUTION -- this stuff is hard-wired
+        if (dname(i) .eq. 'west_east_stag') then
+          dval2(i) = jweg
+          i_shape_we_stag = i
+        else if (dname(i) .eq. 'west_east') then
+          dval2(i) = jweg-1
+          i_shape_we = i
+        else if (dname(i) .eq. 'south_north_stag') then
+          dval2(i) = jsng
+          i_shape_sn_stag = i
+        else if (dname(i) .eq. 'south_north') then
+          dval2(i) = jsng-1
+          i_shape_sn = i
+        else if (dname(i) .eq. 'bottom_top_stag') then
+          dval2(i) = jbtg
+          i_shape_bt_stag = i
+        else if (dname(i) .eq. 'bottom_top') then
+          dval2(i) = jbtg-1
+          i_shape_bt = i
+        endif
+        if ( dname(i) == "Time" ) then
+          status = nf_def_dim(mcid, dname(i), NF_UNLIMITED, i)
+        else
+          status = nf_def_dim(mcid, dname(i), dval2(i), i)
+        end if
+        IF (debug) THEN
+          write(6,'(i4," : ",A," in = ",i4," (out = ",i4,")")') &
+                i,dname(i),dval(i),dval2(i)
+        ENDIF
+      enddo
+      IF (.not. debug) THEN
+        write(6,*)
+        write(6,*) "Set up file DIMENSIONS"
+      ENDIF
+
+! DEALING WITH THE GLOBAL ATTRIBUTES
+      IF (debug) THEN
+        write(6,*) 
+        write(6,*) "FILE attributes:"
+      ENDIF
+      do i = 1, ngatts
+        status = nf_inq_attname(ncid, nf_global, i, name)
+        status = nf_inq_atttype(ncid, nf_global, name, itype)
+        status = nf_inq_attlen(ncid, nf_global, name, ilen)
+
+        if ( itype .eq. 2 ) then        ! characters
+          status = nf_get_att_text (ncid, nf_global, name, cval)
+          IF (debug) THEN
+            write(6,'(i4," : ",A," in = ",A," (out = ",$)') &
+                  i,name,cval(1:ilen)
+          ENDIF
+          if(name(1:5) .eq. 'TITLE') then
+             cval = cval(1:ilen)//" : iowrf"//option
+             ilen = len_trim(cval)
+          endif
+          IF (debug) write(6,'(A,")")') cval(1:ilen)
+          status = nf_put_att_text(mcid, nf_global, name, ilen,&
+                    cval(1:ilen))
+
+        elseif ( itype .eq. 4 ) then     ! integers
+          status = nf_get_att_int (ncid, nf_global, name, ival)
+          IF (debug) THEN
+            write(6,'(i4," : ",A," in = ",i7," (out = ",$)') &
+                  i,name,ival        
+          ENDIF
+          if(name .eq. 'WEST-EAST_GRID_DIMENSION') ival = jweg
+          if(name .eq. 'SOUTH-NORTH_GRID_DIMENSION') ival = jsng
+          if(name .eq. 'BOTTOM-TOP_GRID_DIMENSION') ival = jbtg
+          IF (debug) write(6,'(i7,")")') ival
+          status = nf_put_att_int(mcid, nf_global, name, itype,&
+                    ilen, ival)
+
+        elseif ( itype .eq. 5 ) then    ! real
+          status = nf_get_att_real (ncid, nf_global, name, rval)
+          IF (debug) THEN
+            write(6,'(i4," : ",A," in = ",G18.10E2," (out = ",$)') &
+                  i,name,rval        
+          ENDIF
+          if(name(1:2) .eq. 'DX' .or. name(1:2) .eq. 'DY') rval = okm
+          IF (debug) write(6,'(G18.10E2,")")') rval
+          status = nf_put_att_real(mcid, nf_global, name, itype,&
+                    ilen, rval)
+        endif
+      enddo
+      IF ( .not. debug ) THEN
+        write(6,*) "Write file ATTRIBUTES"
+        write(6,*) 
+      ENDIF
+
+
+! TRAIN FILE
+      do i = 1, nvars
+        status = nf_inq_var(ncid, i, cval, itype, idm, ishape, natt)
+        ishape2 = ishape
+        if ( idm .ge. 4 ) then
+          do ii=1,idm
+            IF     ( option == "-A" .AND. ishape2(ii) == i_shape_bt_stag ) THEN
+              ishape2(ii) = i_shape_bt
+            ELSEIF ( option == "-A" .AND. ishape2(ii) == i_shape_we_stag ) THEN
+              ishape2(ii) = i_shape_we
+            ELSEIF ( option == "-A" .AND. ishape2(ii) == i_shape_sn_stag ) THEN
+              ishape2(ii) = i_shape_sn
+            END IF
+          enddo
+        end if
+
+        status = nf_def_var(mcid, cval, itype, idm, ishape2, i)
+        do na = 1, natt
+          status = nf_inq_attname(ncid, i, na, name)
+          status = nf_copy_att(ncid, i, name, mcid, i)
+        enddo
+      enddo
+      status = nf_enddef(mcid)
+
+! ########## LOOP THROUGH THE DATA 
+      IF (debug) THEN
+        write(6,*) 
+        write(6,*) 
+      ENDIF
+      write(6,*) "Write file VARIABLES:"
+      start_dims = 1
+      do i = 1, nvars
+        status = nf_inq_var(ncid, i, cval, itype, idm, ishape, natt)
+        ishape2 = ishape
+        if ( idm .ge. 4 ) then
+          do ii=1,idm
+            IF     ( option == "-A" .AND. ishape2(ii) == i_shape_bt_stag ) THEN
+              ishape2(ii) = i_shape_bt
+            ELSEIF ( option == "-A" .AND. ishape2(ii) == i_shape_we_stag ) THEN
+              ishape2(ii) = i_shape_we
+            ELSEIF ( option == "-A" .AND. ishape2(ii) == i_shape_sn_stag ) THEN
+              ishape2(ii) = i_shape_sn
+            END IF
+          enddo
+        end if
+        IF (debug) THEN
+          write(6,*) 
+        ENDIF
+        write(6,*) 'VARIABLE: ',trim(cval)
+
+! GET THE DIMS FOR INPUT AND OUTPUT FROM THE SHAPE
+        dims_in  = 1
+        dims_out = 1
+        do ii = 1,idm
+          dims_in(ii)  = dval(ishape(ii))
+          dims_out(ii) = dval2(ishape2(ii))
+        enddo
+        IF (debug) THEN
+          write(6,*) '   DIMS  IN: ',dims_in
+          write(6,*) '   DIMS OUT: ',dims_out
+        ENDIF
+
+        IF ( option == '-box' ) THEN
+           !! Get the start and end dimensions of the box in the input file
+           firstS  = 1
+           firstE  = dims_out(1)
+           secondS = 1
+           secondE = dims_out(2)
+           thirdS  = 1
+           thirdE  = dims_out(3)
+
+          if (idm.eq.2 .and. dims_out(1).ge.jbtg-1 .and. box_end(3).ne.0) then
+            firstS = box_start(3)
+            firstE = box_end(3)
+            if (dims_out(3) .eq. jbtg-1) firstE = firstE-1
+          endif
+          if (idm .ge. 3) then
+            if (box_end(1) .ne. 0) then
+              firstS = box_start(1)
+              firstE = box_end(1)
+              if (dims_out(1) .eq. jweg-1) firstE = firstE-1
+            endif
+            if (box_end(2) .ne. 0) then
+              secondS = box_start(2)
+              secondE = box_end(2)
+              if (dims_out(2) .eq. jsng-1) secondE = secondE-1
+            endif
+            if (idm == 4 .and. box_end(3).ne.0) then
+              thirdS = box_start(3)
+              thirdE = box_end(3)
+              if (dims_out(3) .eq. jbtg-1) thirdE = thirdE-1
+            endif
+          endif
+        ENDIF
+
+! ALLOCATE THE INPUT AND OUTPUT ARRAYS
+! READ THE DATA FROM INPUT FILE
+! THIN THE GRID IF NEEDED, OR GET THE CORRECT BOX
+
+        IF     (itype .eq. 2) THEN          ! character
+          allocate (text(dims_in(1), dims_in(2), dims_in(3), &
+                         dims_in(4)))
+          status = nf_get_var_text(ncid, i, text)
+          IF (debug) write(6,*) '   SAMPLE VALUE = ',text(:,1,1,1)
+          status = nf_put_vara_text (mcid, i, start_dims, dims_in, text)
+          deallocate (text)
+
+        ELSEIF (itype .eq. 4) THEN          ! integer
+          allocate (idata(dims_in(1), dims_in(2), dims_in(3), &
+                          dims_in(4)))
+          allocate(idata2(dims_out(1),dims_out(2),dims_out(3),&
+                          dims_out(4)))
+          status = nf_get_var_int(ncid, i, idata)
+          IF (debug) write(6,*) '   SAMPLE VALUE = ',idata(1,1,1,1)
+          IF ( option == '-thina' ) THEN   
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              allocate(data2(dims_out(1),dims_out(2),dims_out(3),&
+                              dims_out(4)))
+              call thin_ave (real(idata),data2,dims_in(1),dims_in(2),          &
+                             dims_in(3),dims_in(4),dims_out(1),dims_out(2),    &
+                             dims_out(3),dims_out(4),iratio)       
+              idata2 = int(data2)
+              deallocate(data2)
+            else
+              idata2 = idata
+            endif
+          ELSEIF ( option == '-thin' ) THEN   
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              idata2 = idata(1:dims_in(1):iratio,1:dims_in(2):iratio,:,:)
+            else
+              idata2 = idata
+            endif
+          ELSEIF ( option == '-A' ) THEN   
+            idata2 = idata
+          ELSEIF ( option == '-box') THEN
+            IF (debug) write(6,*) '   a BOX is extracted from the input domain '  
+            idata2 = idata(firstS:firstE,secondS:secondE,thirdS:thirdE,:)
+          ENDIF
+          status = nf_put_vara_int (mcid, i, start_dims, dims_out, idata2)
+          deallocate (idata)
+          deallocate (idata2)
+
+        ELSEIF (itype .eq. 5) THEN          ! real
+          allocate (data(dims_in(1), dims_in(2), dims_in(3), &
+                         dims_in(4)))
+          allocate(data2(dims_out(1),dims_out(2),dims_out(3), &
+                         dims_out(4)))
+          status = nf_get_var_real(ncid, i, data)
+          IF (debug) write(6,*) '   SAMPLE VALUE = ',data(1,1,1,1)
+          IF ( option == '-thina' ) THEN    
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              call thin_ave (data,data2,dims_in(1),dims_in(2),               &
+                             dims_in(3),dims_in(4),dims_out(1),dims_out(2),  &
+                             dims_out(3),dims_out(4),iratio)       
+            else
+              data2 = data
+            endif
+          ELSEIF ( option == '-thin' ) THEN    
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              data2 = data(1:dims_in(1):iratio,1:dims_in(2):iratio,:,:)
+            else
+              data2 = data
+            endif
+          ELSEIF ( option == '-A' ) THEN    
+            if     (idm .eq. 4 .AND. (dims_in(1) > dims_out(1)) ) then
+              IF (debug) write(6,*) '   de-staggering in the X direction'
+              data2 = (data(1:dims_in(1)-1,:,:,:)+data(2:dims_in(1),:,:,:))*.5
+            elseif (idm .eq. 4 .AND. (dims_in(2) > dims_out(2)) ) then
+              IF (debug) write(6,*) '   de-staggering in the Y direction'
+              data2 = (data(:,1:dims_in(2)-1,:,:)+data(:,2:dims_in(2),:,:))*.5
+            elseif (idm .eq. 4 .AND. (dims_in(3) > dims_out(3)) ) then
+              IF (debug) write(6,*) '   de-staggering in the Y direction'
+              data2 = (data(:,:,1:dims_in(3)-1,:)+data(:,:,3:dims_in(2),:))*.5
+            else
+              data2 = data
+            endif
+          ELSEIF ( option == '-box') THEN
+            IF (debug) write(6,*) '   a BOX is extracted from the input domain '  
+            data2 = data(firstS:firstE,secondS:secondE,thirdS:thirdE,:)
+          ENDIF
+          status = nf_put_vara_real (mcid, i, start_dims, dims_out, data2)
+          IF ( cval == 'XLAT' .or. cval == 'XLONG' ) THEN
+!            We need fix the box's center long and lat
+             new_cen = data2(ix,iy,1,1)
+                 if ( x_ave .and. y_ave ) then
+               new_cen = (data2(ix,  iy,1,1)+data2(ix  ,iy+1,1,1)+  &
+                          data2(ix+1,iy,1,1)+data2(ix+1,iy+1,1,1))/4.
+             elseif ( x_ave .and. .not. y_ave ) then
+               new_cen = (data2(ix,  iy,1,1)+data2(ix+1,iy  ,1,1))/2.
+             elseif ( .not. x_ave .and. y_ave ) then
+               new_cen = (data2(ix,  iy,1,1)+data2(ix  ,iy+1,1,1))/2.
+             endif
+          ENDIF
+          IF ( cval == 'XLAT' ) THEN
+             IF (debug) write(6,*) '   Fix global attribute CEN_LAT: now = ', new_cen
+             status = nf_inq_atttype(ncid, nf_global, 'CEN_LAT', itype)
+             status = nf_inq_attlen(ncid, nf_global, 'CEN_LAT', ilen)
+             status = nf_put_att_real(mcid, nf_global, 'CEN_LAT', itype,&
+                       ilen, new_cen)
+          ELSEIF ( cval == 'XLONG' ) THEN
+             IF (debug) write(6,*) '   Fix global attribute CEN_LON: now = ', new_cen
+             status = nf_inq_atttype(ncid, nf_global, 'CEN_LON', itype)
+             status = nf_inq_attlen(ncid, nf_global, 'CEN_LON', ilen)
+             status = nf_put_att_real(mcid, nf_global, 'CEN_LON', itype,&
+                       ilen, new_cen)
+          ENDIF
+          deallocate (data)
+          deallocate (data2)
+
+        ELSEIF (itype .eq. 6) THEN          ! double
+          allocate (ddata(dims_in(1), dims_in(2), dims_in(3), &
+                          dims_in(4)))
+          allocate(ddata2(dims_out(1),dims_out(2),dims_out(3),&
+                          dims_out(4)))
+          status = nf_get_var_double(ncid, i, ddata)
+          IF (debug) write(6,*) '   SAMPLE VALUE = ',ddata(1,1,1,1)
+          IF ( option == '-thina' ) THEN    
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              allocate(data2(dims_out(1),dims_out(2),dims_out(3),&
+                              dims_out(4)))
+              call thin_ave (real(ddata),data2,dims_in(1),dims_in(2),               &
+                             dims_in(3),dims_in(4),dims_out(1),dims_out(2),    &
+                             dims_out(3),dims_out(4),iratio)       
+              ddata2 = data2
+              deallocate (data2)
+            else
+              ddata2 = ddata
+            endif
+          ELSEIF ( option == '-thin' ) THEN 
+            if (idm .ge. 3) then
+              IF (debug) write(6,*) '   Grid is thinned with a ratio of ',iratio
+              ddata2 = ddata(1:dims_in(1):iratio,1:dims_in(2):iratio,:,:)
+            else
+              ddata2 = ddata
+            endif
+          ELSEIF ( option == '-A' ) THEN    
+            if     (idm .eq. 4 .AND. (dims_in(1) > dims_out(1)) ) then
+              IF (debug) write(6,*) '   de-staggering in the X direction'
+              ddata2 = (ddata(1:dims_in(1)-1,:,:,:)+ddata(2:dims_in(1),:,:,:))*.5
+            elseif (idm .eq. 4 .AND. (dims_in(2) > dims_out(2)) ) then
+              IF (debug) write(6,*) '   de-staggering in the Y direction'
+              ddata2 = (ddata(:,1:dims_in(2)-1,:,:)+ddata(:,2:dims_in(2),:,:))*.5
+            elseif (idm .eq. 4 .AND. (dims_in(3) > dims_out(3)) ) then
+              IF (debug) write(6,*) '   de-staggering in the Z direction'
+              ddata2 = (ddata(:,:,1:dims_in(3)-1,:)+ddata(:,:,3:dims_in(2),:))*.5
+            else
+              ddata2 = ddata
+            endif
+          ELSEIF ( option == '-box') THEN
+            IF (debug) write(6,*) '   a BOX is extracted from the input domain '  
+            ddata2 = ddata(firstS:firstE,secondS:secondE,thirdS:thirdE,:)
+          ENDIF
+          status = nf_put_vara_double (mcid, i, start_dims, dims_out, ddata2)
+          deallocate (ddata)
+          deallocate (ddata2)
+        ELSE
+            stop 'trouble - do not know the variable type'
+        ENDIF
+
+      ENDDO     ! END OF VARIABLE LOOP
+      status = nf_close(mcid)
+
+      write(6,*) 
+      write(6,*) "SUCCESS - we are out of here"      
+      write(6,*) "#########################################"
+
+      end program iowrf
+!---------------------------------------------------------------------
+      subroutine handle_err(status)
+      integer status
+      write(6,*) 'Error number ',status
+      stop
+      end subroutine
+!---------------------------------------------------------------------
+      subroutine thin_ave (ain, aou, a1, a2, a3, a4, b1, b2, b3, b4, &
+             iratio)
+! average one array into another in x,y. 
+      integer a1, a2, a3, a4, b1, b2, b3, b4,iratio
+      real ain(a1,a2,a3,a4), aou(b1,b2,b3,b4)
+      !write(6,*) 'begin thin_ave, ratio = ',iratio
+      !write(6,*) 'a1 = ',a1,' a2 = ',a2,' a3 = ',a3,' a4 = ',a4
+      !write(6,*) 'b1 = ',b1,' b2 = ',b2,' b3 = ',b3,' b4 = ',b4
+      do k4 = 1, b4
+      do k3 = 1, b3
+      do j = 1, b2
+        ymx = (((j-1) * iratio) + 1 ) + iratio/2.
+        ymn = (((j-1) * iratio) + 1 ) - iratio/2.
+        ymx = amin1(float(a2),ymx)
+        ymn = amax1(1.,ymn)
+        !write(6,*) 'ymn = ',ymn,' ymx = ',ymx
+      do i = 1, b1
+        !write(6,*) 'i = ',i,' j = ',j
+        xmx = (((i-1) * iratio) + 1 ) + iratio/2.
+        xmn = (((i-1) * iratio) + 1 ) - iratio/2.
+        xmx = amin1(float(a1),xmx)
+        xmn = amax1(1.,xmn)
+        !write(6,*) 'xmn = ',xmn,' xmx = ',xmx
+        nc = 0
+        sum = 0.
+        nn1 = int(ymn+.5)
+        nn2 = int(ymx)
+        do n = nn1, nn2
+          mm1 = int(xmn+.5)
+          mm2 = int(xmx)
+          !write(6,*) 'nn1 = ',nn1,' nn2 = ',nn2
+          !write(6,*) 'mm1 = ',mm1,' mm2 = ',mm2
+          do m = mm1, mm2
+            sum = ain(m,n,k3,k4) + sum
+            !write(6,*) 'm = ',m,' n = ',n,' ain = ',ain(m,n,k3,k4),&
+            ! ' sum = ',sum
+            nc = nc + 1
+          enddo
+        enddo
+        aou(i,j,k3,k4) = sum/float(nc)
+        !write(6,*) 'i = ',i,' value = ',aou(i,j,k3,k4)
+      enddo
+      enddo
+      enddo
+      enddo
+
+      end subroutine thin_ave 
+!--------------------------------------------------------
+
+  subroutine read_args(input_file,option,iratio,box_start,box_end,bit64,debug)
+
+  implicit none
+  character (len=80)    :: input_file
+  character (len=10)    :: option
+
+  integer               :: iratio
+  integer               :: box_start(3), box_end(3)
+  logical               :: bit64, debug
+
+  integer               :: numarg, i, idummy, idummy1, idummy2
+  real                  :: rdummy
+  integer, external     :: iargc
+  character (len=80)    :: dummy, dir
+
+! set up some defaults first
+  input_file = " "
+  option = " "
+  idummy1 = 0
+  idummy2 = 0
+  box_start = 0
+  box_end   = 0
+  bit64 = .FALSE.
+  numarg = iargc()
+  i = 1
+
+  if (numarg .lt. 1) call help_info
+
+  do while (i <= numarg)
+    call getarg(i,dummy)
+
+    if (dummy(1:1) == "-") then    ! We have an option, else it is the filename
+
+      SELECTCASE (trim(dummy))
+          CASE ("-help")
+               call help_info
+          CASE ("-h")
+               call help_info
+          CASE ("-debug")
+               debug = .TRUE.     
+          CASE ("-thina")
+               option = dummy
+               i = i+1
+               call getarg(i,dummy)
+               read(dummy,'(i3)')idummy
+               iratio = idummy
+               if ( iratio .lt. 2 ) STOP ' Must supply a ratio of 2 or more ' 
+          CASE ("-thin")
+               option = dummy
+               i = i+1
+               call getarg(i,dummy)
+               read(dummy,'(i3)')idummy
+               iratio = idummy
+               if ( iratio .lt. 2 ) STOP ' Must supply a ratio of 2 or more ' 
+          CASE ("-A")
+               option = dummy
+          CASE ("-box")
+               option = dummy
+               DO 
+                 i = i+1
+                 call getarg(i,dir)
+                 if (dir(1:1) == '-') then
+                   i=i-1
+                   exit
+                 endif
+                 if (dir.ne.'x') then
+                 if (dir.ne.'y') then
+                 if (dir.ne.'z') then
+                   i=i-1
+                   exit
+                 endif
+                 endif
+                 endif
+                 i = i+1
+                 call getarg(i,dummy)
+                 read(dummy,'(i3)')idummy1
+                 i = i+1
+                 call getarg(i,dummy)
+                 read(dummy,'(i3)')idummy2
+                 if (dir.eq.' '.or.idummy1.eq.0.or.idummy2.eq.0) exit
+                 if ( dir == 'x' ) then
+                   box_start(1) = idummy1
+                   box_end(1)   = idummy2
+                 endif
+                 if ( dir == 'y' ) then
+                   box_start(2) = idummy1
+                   box_end(2)   = idummy2
+                 endif
+                 if ( dir == 'z' ) then
+                   box_start(3) = idummy1
+                   box_end(3)   = idummy2
+                 endif
+                 idummy1 = 0
+                 idummy2 = 0
+               ENDDO
+          CASE ("-64bit")
+               bit64 = .TRUE.
+          CASE DEFAULT
+               call help_info
+      END SELECT
+    else
+      input_file = dummy
+    endif
+
+      i = i+1
+
+  enddo
+
+  if (input_file == " ") call help_info
+
+  end subroutine read_args
+!------------------------------------------------------------------------------
+
+  subroutine help_info
+
+  print*," "
+  print*," iowrf   wrf_data_file_name  [-options] "
+  print*," "
+  print*," Current options available are:"
+  print*," -help     : Print this information"                           
+  print*," -h        : Print this information"                           
+  print*," "
+  print*," -thina x  : Thin the input grid, with a ratio of x"  
+  print*,"             Example:"
+  print*,"                -thina 3 " 
+  print*,"             Will thin the grid with a ratio of 3, i.e.,   "
+  print*,"             a 12km grid will be upscaled to a 36km grid" 
+  print*,"             The new grid point will be an average of the surrounding points"
+  print*," "
+  print*," -thin x   : Thin the input grid, with a ratio of x"  
+  print*,"             Example:"
+  print*,"                -thin 3 " 
+  print*,"             Will thin the grid with a ratio of 3, i.e.,   "
+  print*,"             a 12km grid will be upscaled to a 36km grid" 
+  print*,"             The new grid point will be the feedback value from the input domain"
+  print*," "
+  print*," -box [ ]  : Will extract a box out of the input grid"
+  print*,"             The box can have values for x/y/z  "
+  print*,"             Examples:"
+  print*,"                -box x 10 30 y 20 40 z 5 15" 
+  print*,"                -box x 10 30 y 20 40 " 
+  print*,"                -box x 10 30 " 
+  print*,"                -box y 20 40 " 
+  print*," "
+  print*," -A        : De-stagger output"
+  print*," "
+  print*," -64bit    : To create large 64bit data files"
+  print*," "
+  end subroutine help_info
+
+!------------------------------------------------------------------------------
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api	(revision 19)
@@ -0,0 +1,63 @@
+&io
+! path_to_input  = './dossier/ALT_POLAR_top0.1_sponge_smooth_topo/'  !! ne doit pas etre trop long
+! path_to_output = './smooth'
+ path_to_input  = './dossier/ALT_POLAR_top0.1_sponge/'
+ path_to_output = './'
+! input_name     = 'wrfout_d01_2024*'
+ input_name     = 'wrfout_d01_2024-07-03_06:00:00'
+! path_to_input = './dossier_test/'
+! input_name     = 'wrfout_d01_2024-01-05_02:00:00'
+! input_name     = 'nca_wrfout_d01_2024-01-05_02:00:00'
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, GHT)     
+! fields         = 'W,SWDOWNZ,TAU_DUST,TSURF,XLONG,XLAT,HGT'
+! fields         = 'W'
+! fields         = 'U,V'  !! beware, not only tk ! only one 3D field at least
+ fields         = 'tk,W,uvmet'  
+ debug          = .TRUE.
+/
+ process = 'all'  !! process all fields in file
+ debug = .TRUE.
+ bit64 = .TRUE. ! bit64 = .TRUE. !! ne pas utiliser ?
+
+&interp_in
+! interp_levels = 1000.,987.5,975.,962.5,950.,937.5,925., 
+!                 900.,875.,850.,825.,800.,750.,700.,650.,  
+!                 600.,550.,500.,450.,400.,350.,300.,250., 
+!                 225.,200.,175.,150.,137.5,125.,112.5,100., 
+!                 87.5,75.,62.5,50.,37.5,25.,12.5,
+!interp_levels = 5., 4.9, 4.8, 4.7, 4.6, 4.5, 4.4, 4.3, 4.2, 4.1, 4.0,
+!                    3.9, 3.8, 3.7, 3.6, 3.5, 3.4, 3.3, 3.2, 3.1, 3.0,
+!                    2.9, 2.8, 2.7, 2.6, 2.5, 2.4, 2.3, 2.2, 2.1, 2.0,
+!                    1.9, 1.8, 1.7, 1.6, 1.5, 1.4, 1.3, 1.2, 1.1, 1.0,
+!                    0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1, 
+! interp_levels = 5., 3., 1., 0.1
+! interp_method = 2,
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+! interp_method = 4
+! interp_levels = 20.
+! interp_levels = -09., -08., -07., -06., -05., -04., -03., -02., -01.,  00.,
+!                  01.,  02.,  03.,  04.,  05.,  06.,  07.,  08.,  09.,
+! interp_levels =  01.,  02.,  03.,  04.,  05.,  06.,  07.,  08.,  09.,
+!                  10.,  11.,  12.,  13.,  14.,  15.,  16.,  17.,  18.,  19.,
+!                  20.,  21.,  22.,  23.,  24.,  25.,  26.,  27.,  28.,  29.,
+!!                  30.,  31.,  32.,  33.,  34.,  35.,  36.,  37.,  38.,  39.,
+!!                  40.,  41.,  42.,  43.,  44.,  45.,  46.,  47.,  48.,  49.
+! interp_levels =               01.,  01.5,  02.,  02.5,  03.,  03.5,  04.,  04.5,  05.,  05.5,  06.,  06.5,  07.,  07.5,  08.,  08.5,  09.,  09.5 
+!                  10.,  10.5,  11.,  11.5,  12.,  12.5,  13.,  13.5,  14.,  14.5,  15.,  15.5,  16.,  16.5,  17.,  17.5,  18.,  18.5,  19.,  19.5
+!                  20.,  20.5,  21.,  21.5,  22.,  22.5,  23.,  23.5,  24.,  24.5,  25.,  25.5,  26.,  26.5,  27.,  27.5,  28.,  28.5,  29.,  29.5
+ interp_levels = 20.0
+! interp_levels = 01.00,01.25,01.50,01.75,02.00,02.25,02.50,02.75,03.00,03.25,03.50,03.75,04.00,04.25,04.50,04.75,05.00,
+!                       05.25,05.50,05.75,06.00,06.25,06.50,06.75,07.00,07.25,07.50,07.75,08.00,08.25,08.50,08.75,09.00,
+!                       09.25,09.50,09.75,10.00,10.25,10.50,10.75,11.00,11.25,11.50,11.75,12.00,12.25,12.50,12.75,13.00,
+!                       13.25,13.50,13.75,14.00,14.25,14.50,14.75,15.00,15.25,15.50,15.75,16.00,16.25,16.50,16.75,17.00
+! interp_method = 2,
+! interp_levels = 1.,
+/
+ extrapolate = 1,
+ interp_method = 2,
+ unstagger_grid = .TRUE.  !! pb !! non c OK
+
+ extrapolate = 0    ;; set values below ground and above model top to missing (default)
+ extrapolate = 1    ;; extrapolate below ground, and set above model top to model top values
+ interp_method = 1  ;; linear in p interpolation (default)
+ interp_method = 2  ;; linear in log p interpolation
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_altieri
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_altieri	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_altieri	(revision 19)
@@ -0,0 +1,34 @@
+&io
+ path_to_input  = './liens/gw/'
+ path_to_output = './gw/'
+ path_to_output = './gw/30km/'
+ !path_to_input  = './liens/gwsmooth/'
+ !path_to_output = './gwsmooth/'
+ !path_to_input  = './liens/gwhires/'
+ !path_to_output = './gwhires/'
+ input_name     = 'wrfout_d01_2024*' 
+ oldvar         = T
+ process        = 'list'         
+ fields         = 'W,HGT,SWDOWNZ,uvmet,TSURF'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 
+ interp_levels = 
+!                     15.,16.,17.,18.,19.,   
+! 20.,21.,22.,23.,24.,25.,26.,27.,28.,29.,
+! 30.,31.,32.,33.,34.,35.,36.,37.,38.,39.,
+! 40.,41.,42.,43.,44.,45.,46.,47.,48.,49.,
+! 2., 4., 6., 8.,10.,
+!12.,14.,16.,18.,20.,
+!22.,24.,26.,28.,30.,
+!32.,34.,36.,38.,40.,
+!42.,44.,46.,48.,50.,
+!52.,54.,56.,58.,60., 
+!                     15.,16.,17.,18.,19.,
+! 20.,21.,22.,23.,24.,25.,26.,27.,28.,29.,
+! 30.,31.,32.,33.,34.,35.
+! 35.
+30.
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_appere
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_appere	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_appere	(revision 19)
@@ -0,0 +1,16 @@
+&io
+! path_to_input  = '/tmp15/aslmd/polar_61pts/'
+! path_to_output = '/tmp15/aslmd/polar_61pts/'
+ path_to_input = '/d5/aslmd/LMD_MM_MARS_SIMUS/polar_61pts/'
+ path_to_output = '/d5/aslmd/LMD_MM_MARS_SIMUS/polar_61pts/'
+ input_name     = 'wrfout_d01_2024-03-04_06:00:00'
+ oldvar         = T
+ process        = 'list'         
+ fields         = 'HGT,uvmet,tk,HFX,USTM'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 4                 
+ interp_levels = 0.01, 0.02, 0.05, 0.1, 0.2, 0.5, 20.
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_bomb
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_bomb	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_bomb	(revision 19)
@@ -0,0 +1,17 @@
+&io
+ path_to_input  = '/tmp7/aslmd/MERIDIANI_BOMB/'
+ input_name     = 'wrfout_d01_2024-09-07_06:00:00'
+ oldvar         = T
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, GHT)     
+ fields         = 'HGT,TSURF,tk,uvmet,W'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+! interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+ interp_levels = 2., 4., 6., 8., 10., 
+                12.,14.,16.,18., 20.,
+                22.,24.,26.,28., 30.,
+! unstagger_grid = .TRUE.           !! TO PUT regular U and V in uvmet
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_duststorm
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_duststorm	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_duststorm	(revision 19)
@@ -0,0 +1,18 @@
+&io
+ path_to_input  = '/d5/lmlmd/Aymeric/meso_DUST_STORM_ASSIM/'
+ path_to_output = './'
+ input_name     = 'wrfout_d01_2024-07-09_00:00:00'
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, ght)    TRY 'all' 
+ fields         = 'W,TAU_DUST,tk'
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+ interp_levels = -09., -08., -07., -06., -05., -04., -03., -02., -01.,  00.,
+                  01.,  02.,  03.,  04.,  05.,  06.,  07.,  08.,  09.,
+                  10.,  11.,  12.,  13.,  14.,  15.,  16.,  17.,  18.,  19.,
+                  20.,  21.,  22.,  23.,  24.,  25.,  26.,  27.,  28.,  29.,
+!                  30.,  31.,  32.,  33.,  34.,  35.,  36.,  37.,  38.,  39.,
+!                  40.,  41.,  42.,  43.,  44.,  45.,  46.,  47.,  48.,  49.
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_exomars
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_exomars	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_exomars	(revision 19)
@@ -0,0 +1,84 @@
+&io
+ path_to_input  = './liens/MERIDIANI/saves_simu_LS_68.5/jour20/'
+ path_to_input  = './liens/MERIDIANI/saves_simu_LS_244_tau05/'
+ path_to_input  = '/home/aslmd/EXOMARS/MERIDIANI_FLUSH2/'
+ !path_to_output = '/home/aslmd/EXOMARS/MERIDIANI_FLUSH/'
+ input_name     = 'wrfout_d01_2024-09-13_06:00:00'
+ process        = 'list'         
+ oldvar		= .TRUE.
+ fields         = 'tk, uvmet, W, PTOT, TSURF, PSFC, HGT'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 4
+ interp_levels = 
+ 0.005,
+ 0.010,
+ 0.020,
+ 0.050,
+ 0.100,
+ 0.200,
+ 0.500,
+ 1.000,
+ 1.500,
+ 2.000,
+ 2.500,
+ 3.000,
+ 3.500,
+ 4.000,
+ 4.500,
+ 5.000,
+ 5.500,
+ 6.000,
+ 6.500,
+ 7.000,
+ 7.500,
+ 8.000,
+ 8.500,
+ 9.000,
+ 9.500,
+10.000,
+10.500,
+11.000,
+11.500,
+12.000,
+12.500,
+13.000,
+13.500,
+14.000,
+14.500,
+15.000,
+15.500,
+16.000,
+16.500,
+17.000,
+17.500,
+18.000,
+18.500,
+19.000,
+19.500,
+20.000,
+20.500,
+21.000,
+21.500,
+22.000,
+22.500,
+23.000,
+23.500,
+24.000,
+24.500,
+25.000,
+25.500,
+26.000,
+26.500,
+27.000,
+27.500,
+28.000,
+28.500,
+29.000,
+29.500,
+30.000,
+/
+!! unstagger_grid = .TRUE. !!PB
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_generic
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_generic	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_generic	(revision 19)
@@ -0,0 +1,15 @@
+&io
+ path_to_input  = '/tmp7/aslmd/results/'
+ input_name     = 'wrfout_d01_2024-07-02*'
+ oldvar         = T
+ path_to_output = '/tmp7/aslmd/results/'
+ process        = 'list'         
+ fields         = 'tk,W,HGT,SWDOWNZ,uvmet'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+! interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+ interp_levels = 10.,20.,30.,40.
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw	(revision 19)
@@ -0,0 +1,16 @@
+&io
+ path_to_input  = './liens/gw/'
+ input_name     = 'wrfout_d01_2024*'
+ oldvar         = T
+ path_to_output = './'
+ process        = 'list'         
+ fields         = 'tk,W,uvmet,HGT'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+! interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+! interp_levels = 0.010
+ interp_levels = 10.
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw_ideal
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw_ideal	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_gw_ideal	(revision 19)
@@ -0,0 +1,124 @@
+&io
+ path_to_input  = '../TESTGW/'
+! input_name     = 'ok_hires_wrfout*'
+! input_name     = 'ok_wrfout*'
+! input_name     = 'ok2_wrfout*'
+! input_name     = 'ok3_*wrfout*'
+! input_name     = 'ok_hires_day_wrfout*'
+! input_name     = 'ok_hires_day_phys_wrfout*'
+! input_name     = 'mcd_lt16_rcpcst_wrfout*'
+! input_name     = 'mcd_lt16_wrfout*'
+ input_name     = '_wrfout*'
+! input_name     = 'short_mcd_lt16_calcprho_wrfout*'
+! input_name     = 'mcd_lt16_calcprho_wrfout*'
+! input_name     = 'short_mcd_lt16_calcprho_tot_wrfout*'
+! input_name     = 'colder_gcm_add_wrfout*'
+! input_name     = 'colder_gcm_add_3.9_fine_rad_mountain_wrfout*'
+ path_to_output  = '../TESTGW/'
+ process        = 'list'         
+ oldvar		= .TRUE.
+ fields         = 'tk, uvmet, W, PTOT, TSURF, PSFC, HGT, tpot'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3
+ interp_levels = 
+ -2.000,
+ -1.000,
+ 0.010,
+ 1.000,
+ 2.000,
+ 3.000,
+ 4.000,
+ 5.000,
+ 6.000,
+ 7.000,
+ 8.000,
+ 9.000,
+10.000,
+11.000,
+12.000,
+13.000,
+14.000,
+15.000,
+16.000,
+17.000,
+18.000,
+19.000,
+20.000,
+21.000,
+22.000,
+23.000,
+24.000,
+25.000,
+26.000,
+27.000,
+28.000,
+29.000,
+30.000,
+31.000,
+32.000,
+33.000,
+34.000,
+35.000,
+36.000,
+37.000,
+38.000,
+39.000,
+40.000,
+41.000,
+42.000,
+43.000,
+44.000,
+45.000,
+46.000,
+47.000,
+48.000,
+49.000,
+50.000,
+51.000,
+52.000,
+53.000,
+54.000,
+55.000,
+56.000,
+57.000,
+58.000,
+59.000,
+60.000,
+61.000,
+62.000,
+63.000,
+64.000,
+65.000,
+66.000,
+67.000,
+68.000,
+69.000,
+70.000,
+72.000,
+74.000,
+76.000,
+78.000,
+80.000,
+82.000,
+84.000,
+86.000,
+88.000,
+90.000,
+92.000,
+94.000,
+96.000,
+98.000,
+100.000,
+105.000,
+110.000,
+115.000,
+120.000,
+125.000,
+130.000,
+135.000,
+140.000,
+/
+
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_intercomp
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_intercomp	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_intercomp	(revision 19)
@@ -0,0 +1,14 @@
+&io
+ path_to_input  = '/tmp7/aslmd/test/'
+ input_name     = 'wrfout_d02_2024-05-55_06:00:00'
+ oldvar         = T
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, GHT)     
+ fields         = 'U,V,HGT' !! uvmet,HGT'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+ interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+ interp_levels = 0.01
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_marsjournal
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_marsjournal	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_marsjournal	(revision 19)
@@ -0,0 +1,14 @@
+&io
+ path_to_input  = './liens/marsjournal/month4/'
+ input_name     = 'wrfout_d01_2024-04-01_06:00:00'
+ oldvar         = T
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, GHT)     
+ fields         = 'uvmet,HGT,USTM'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+ interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+ interp_levels = 0.01
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_polar
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_polar	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_polar	(revision 19)
@@ -0,0 +1,21 @@
+&io
+ path_to_input  = './liens/holden/'
+ input_name     = 'wrfout_d03_2024-06-20_06:00:00'
+! path_to_input  = './liens/holden_singledomain/jour20/'
+! input_name     = 'wrfout_d01_2024-06-20_06:00:00'
+! oldvar         = T
+! path_to_input  = '/tmp7/aslmd/one_more_nest/test/'
+! path_to_output = '/tmp7/aslmd/one_more_nest/test/'
+! input_name     = 'wrfout_d02_2024-06-19_06:00:00'
+! oldvar         = T
+ process        = 'list'    !! list fields required in "fields" (available tk, tpot, GHT)     
+ fields         = 'tk,WAVE,uvmet,HGT'  
+ debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 3                 !! INTERPOLATION: ALTITUDE ABOVE MOLA AREOID (km)
+! interp_method = 4		   !! INTERPOLATION: ALTITUDE ABOVE SURFACE (km)
+ interp_levels = 6., 20.
+! interp_levels = 0.02
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_sav
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_sav	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_sav	(revision 19)
@@ -0,0 +1,1 @@
+link /u/aslmd/Save/MODELES/POSTPROC/namelist.api
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_ti
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_ti	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/namelist.api_ti	(revision 19)
@@ -0,0 +1,42 @@
+&io
+ path_to_input  = './liens/OM/OM6_TI85/'
+ path_to_output = './liens/OM/OM6_TI85/'
+ input_name     = 'wrfout_d01_2024-06-43_06:00:00'
+ oldvar         = F
+ process        = 'list'         
+ fields         = 'WAVE,HGT,uvmet,TSURF,tk,tpot,HFX,LWDOWNZ,USTM,HR_SW,HR_LW'  
+ debug          = .TRUE.
+! path_to_input  = './liens/OM/OM10_mesopaper/'
+! path_to_output = './liens/OM/OM10_mesopaper/'
+! input_name     = 'wrfout_d01_2024-06-43*'
+! oldvar         = T
+! process        = 'list'
+! fields         = 'W,HGT,uvmet,TSURF,tk,tpot,LWDOWN'
+! debug          = .TRUE.
+! path_to_input  = './liens/OM/nocst_TI/OM40/'
+! path_to_output = './liens/OM/nocst_TI/OM40/'
+! input_name     = 'wrfout_d01_2024-06-37*'
+! oldvar         = T
+! process        = 'list'
+! fields         = 'W,HGT,uvmet,TSURF,tk,tpot,LWDOWN'
+! debug          = .TRUE.
+! path_to_input  = './liens/OM/OM20/'
+! path_to_output = './liens/OM/OM20/'
+! input_name     = 'wrfout_d01_2024-06-43*'
+! oldvar         = T
+! process        = 'list'
+! fields         = 'W,HGT,uvmet,TSURF,tk,tpot,LWDOWNZ,HFX,USTM'
+! debug          = .TRUE.
+! path_to_input  = './liens/OM/nocst_TI/OM10/'
+! path_to_output = './liens/OM/nocst_TI/OM10/'
+! input_name     = 'wrfout_d01_2024-06-43*'
+! oldvar         = T
+! process        = 'list'
+! fields         = 'W,HGT,uvmet,TSURF,tk,tpot,LWDOWN'
+! debug          = .TRUE.
+/
+
+&interp_in
+ interp_method = 4                 
+ interp_levels = 0.005, 0.01, 0.025, 0.05, 0.075, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0, 1.25, 1.5, 1.75, 2.0, 3.0, 4.0, 5.0
+/
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp	(revision 19)
@@ -0,0 +1,38 @@
+&io
+ path_to_input = '/d5/aslmd/LMD_MM_MARS_SIMUS/MERIDIANI_EXOMARS/'
+ input_name = 'wrfout_d01_2024-03*00'
+ path_to_output = './'
+ process = 'all'
+ fields = 'PRES,TT,GHT,HGT'
+ bit64 = .TRUE.
+/
+ debug = .TRUE.
+ bit64 = .TRUE.
+
+! process can be "all", "list", "all_list"
+!	"all" - process all fields in file
+!		diagnostics PRES, TT, GHT, RH are also calculated
+!   	"list" - list fields required in "fields"
+!   		avaliable diagnostics are PRES, TT, GHT, RH
+
+&interp_in
+! interp_levels = 1000.,987.5,975.,962.5,950.,937.5,925., 
+!                 900.,875.,850.,825.,800.,750.,700.,650.,  
+!                 600.,550.,500.,450.,400.,350.,300.,250., 
+!                 225.,200.,175.,150.,137.5,125.,112.5,100., 
+!                 87.5,75.,62.5,50.,37.5,25.,12.5,
+interp_levels = 5., 4.9, 4.8, 4.7, 4.6, 4.5, 4.4, 4.3, 4.2, 4.1, 4.0,
+                    3.9, 3.8, 3.7, 3.6, 3.5, 3.4, 3.3, 3.2, 3.1, 3.0,
+                    2.9, 2.8, 2.7, 2.6, 2.5, 2.4, 2.3, 2.2, 2.1, 2.0,
+                    1.9, 1.8, 1.7, 1.6, 1.5, 1.4, 1.3, 1.2, 1.1, 1.0,
+                    0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1, 
+ interp_method = 2,
+/
+ extrapolate = 1,
+ interp_method = 2,
+ unstagger_grid = .TRUE.
+
+ extrapolate = 0    ;; set values below ground and above model top to missing (default)
+ extrapolate = 1    ;; extrapolate below ground, and set above model top to model top values
+ interp_method = 1  ;; linear in p interpolation (default)
+ interp_method = 2  ;; linear in log p interpolation
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp_ye
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp_ye	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/namelist.pinterp_ye	(revision 19)
@@ -0,0 +1,45 @@
+&io
+ path_to_input = './dossier/'  !! attention, pas trop long
+ input_name = 'wrfout_d01_2024-07-03_06*'
+! path_to_input = '/donnees/aslmd/MODELES//LMD_MM_MARS//TESTCASERUN/'
+! input_name = 'wrfout_d01_2024-01-05_02*'
+ path_to_output = './'
+ process = 'list'  !'all'
+ fields =  'V'     !'PRES,tk,GHT,HGT'
+ bit64 = .TRUE.
+ debug = .TRUE.
+/
+ debug = .TRUE.
+ bit64 = .TRUE.
+
+! process can be "all", "list", "all_list"
+!	"all" - process all fields in file
+!		diagnostics PRES, TT, GHT, RH are also calculated
+!   	"list" - list fields required in "fields"
+!   		avaliable diagnostics are PRES, TT, GHT, RH
+
+&interp_in
+! interp_levels = 1000.,987.5,975.,962.5,950.,937.5,925., 
+!                 900.,875.,850.,825.,800.,750.,700.,650.,  
+!                 600.,550.,500.,450.,400.,350.,300.,250., 
+!                 225.,200.,175.,150.,137.5,125.,112.5,100., 
+!                 87.5,75.,62.5,50.,37.5,25.,12.5,
+!interp_levels = 5., 4.9, 4.8, 4.7, 4.6, 4.5, 4.4, 4.3, 4.2, 4.1, 4.0,
+!                    3.9, 3.8, 3.7, 3.6, 3.5, 3.4, 3.3, 3.2, 3.1, 3.0,
+!                    2.9, 2.8, 2.7, 2.6, 2.5, 2.4, 2.3, 2.2, 2.1, 2.0,
+!                    1.9, 1.8, 1.7, 1.6, 1.5, 1.4, 1.3, 1.2, 1.1, 1.0,
+!                    0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1, 
+! interp_levels = 1., 0.5, 0.3, 0.2, 0.1, 0.05, 0.03, 0.02, 0.01, 0.005, 0.003
+ interp_levels = 2., 1.
+ interp_method = 2,
+! interp_levels = 1. 
+! interp_method = 3
+/
+ extrapolate = 1,
+ interp_method = 2,
+ unstagger_grid = .TRUE.
+
+ extrapolate = 0    ;; set values below ground and above model top to missing (default)
+ extrapolate = 1    ;; extrapolate below ground, and set above model top to model top values
+ interp_method = 1  ;; linear in p interpolation (default)
+ interp_method = 2  ;; linear in log p interpolation
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_new.F90
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_new.F90	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_new.F90	(revision 19)
@@ -0,0 +1,1198 @@
+ PROGRAM p_interp
+!  Program to read wrfout data and interpolate to pressure levels
+!  The program reads namelist.pinterp
+!  November 2007 - Cindy Bruyere
+!
+!=================================Make Executable============================
+!  Make executable:
+!    DEC Alpha
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o p_interp
+!
+!   Linux flags
+!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+!
+!   Sun flags
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o p_interp
+!
+!   SGI flags
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -freeform  -o p_interp
+!
+!   IBM flags 
+!      xlf p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -qfree=f90  -o p_interp
+!
+!   Mac flags (with xlf compiler)
+!      xlf p_interp.F90 -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o p_interp
+!
+!   Mac flags (with g95 compiler)
+!	g95 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!	-I/usr/local/netcdf/include -ffree-form -o p_interp
+!
+!   Mac flags (with pgf90 compiler)
+!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+!
+!============================================================================
+
+      IMPLICIT NONE
+      
+      INCLUDE 'netcdf.inc'
+
+!      REAL, PARAMETER                                    :: Rd = 287.04
+!      REAL, PARAMETER                                    :: Cp = 7.*Rd/2.
+!      REAL, PARAMETER                                    :: RCP = Rd/Cp
+!      REAL, PARAMETER                                    :: p0 = 100000.
+
+!!! MARS MARS MARS
+       REAL, PARAMETER :: Rd          = 192.    ! gas constant m2 s-2 K-1
+       REAL, PARAMETER :: Cp          = 844.6   ! r= 8.314511E+0*1000.E+0/mugaz
+       REAL, PARAMETER :: RCP = Rd/Cp
+       REAL, PARAMETER :: p0 = 610.
+
+
+
+      CHARACTER,         ALLOCATABLE, DIMENSION(:,:,:,:) :: text
+      CHARACTER (LEN=31),ALLOCATABLE, DIMENSION(:)       :: dnamei, dnamej
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: input_file_names
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: output_file_names
+      DOUBLE PRECISION,  ALLOCATABLE, DIMENSION(:,:,:,:) :: ddata1, ddata2
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: data1, data2, data3
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_field, pres_out
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_stagU, pres_stagV
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: ght, phb, qv, tk, rh, tpot
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:)   :: psfc
+      REAL,              ALLOCATABLE, DIMENSION(:,:)     :: ter
+      INTEGER,           ALLOCATABLE, DIMENSION(:)       :: dvali, dvalj
+      INTEGER,           ALLOCATABLE, DIMENSION(:,:,:,:) :: idata1, idata2
+      INTEGER,                        DIMENSION(4)       :: start_dims = 1
+      INTEGER,                        DIMENSION(4)       :: dims_in, dims_out
+      INTEGER,                        DIMENSION(6)       :: ishape, jshape
+
+      CHARACTER (LEN=80)                                 :: cval
+      CHARACTER (LEN=31)                                 :: cname, test_dim_name
+      CHARACTER (LEN=80)                                 :: input_file, output_file, att_text
+      CHARACTER (LEN=250)                                :: path_to_input
+      CHARACTER (LEN=250)                                :: path_to_output
+      CHARACTER (LEN=250)                                :: input_name
+      CHARACTER (LEN=250)                                :: output_name, tmp_name
+      CHARACTER (LEN=10)                                 :: option
+      CHARACTER (LEN=132)                                :: command
+      CHARACTER (LEN=20)                                 :: process, dummy
+      CHARACTER (LEN=2000)                               :: fields, process_these_fields
+      REAL, DIMENSION(99)                                :: interp_levels
+      REAL                                               :: rval
+      REAL                                               :: MISSING=1.e36
+      INTEGER                                            :: LINLOG = 1
+      INTEGER                                            :: interp_method=1
+      INTEGER                                            :: extrapolate=0
+      INTEGER                                            :: ncid, mcid, rcode
+      INTEGER                                            :: idm, ndims, nvars, natt, ngatts
+      INTEGER                                            :: nunlimdimid
+      INTEGER                                            :: i, ii, j, jj, ix, iy, iweg, isng, ibtg
+      INTEGER                                            :: ivar, jvar
+      INTEGER                                            :: times_in_file
+      INTEGER                                            :: ilen, itype, ival, na, funit, ios
+      INTEGER                                            :: num_metgrid_levels
+      INTEGER                                            :: number_of_input_files
+      INTEGER                                            :: ierr, loop, loslen, strlen, lent
+      INTEGER                                            :: is_there
+      LOGICAL                                            :: is_used
+      LOGICAL                                            :: debug=.FALSE.
+      LOGICAL                                            :: interpolate=.FALSE.
+      LOGICAL                                            :: unstagger_grid=.FALSE.
+      LOGICAL                                            :: fix_meta_stag=.FALSE.
+      LOGICAL                                            :: bit64=.FALSE.
+      LOGICAL                                            :: first=.TRUE.
+
+      NAMELIST /io/ path_to_input, input_name, path_to_output, output_name, &
+                    process, fields, debug, bit64
+      NAMELIST /interp_in/ interp_levels, interp_method, extrapolate, unstagger_grid
+
+      path_to_input   = './'
+      path_to_output  = './'
+      output_name     = ' '
+      interp_levels   = -99999.
+      process         = 'all'
+
+
+      ! Read parameters from Fortran namelist
+        DO funit=10,100
+           INQUIRE(unit=funit, opened=is_used)
+           IF (.not. is_used) EXIT
+        END DO
+        OPEN(funit,file='namelist.pinterp',status='old',form='formatted',iostat=ios)
+        IF ( ios /= 0 ) STOP "ERROR opening namelits.pinterp"
+        READ(funit,io)
+        READ(funit,interp_in)
+        CLOSE(funit)
+
+
+      ! Get all the input file names
+
+        lent = len_trim(path_to_input)
+        IF ( path_to_input(lent:lent) /= "/" ) THEN
+           path_to_input = TRIM(path_to_input)//"/"
+        ENDIF
+        lent = len_trim(path_to_output)
+        IF ( path_to_output(lent:lent) /= "/" ) THEN
+           path_to_output = TRIM(path_to_output)//"/"
+        ENDIF
+
+        input_name = TRIM(path_to_input)//TRIM(input_name)
+
+
+        !  Build a UNIX command, and "ls", of all of the input files 
+        loslen = LEN ( command )
+        CALL all_spaces ( command , loslen ) 
+        WRITE ( command , FMT='("ls -1 ",A," > .foo")' ) TRIM ( input_name )
+           
+        !  We stuck all of the matching files in the ".foo" file.  Now we place the 
+        !  number of the those file (i.e. how many there are) in ".foo1". 
+  
+        CALL SYSTEM ( TRIM ( command ) ) 
+        CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
+  
+        !  Read the number of files.
+        OPEN (FILE   = '.foo1'       , &
+              UNIT   = 112           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+  
+        READ ( 112 , * ) number_of_input_files
+        CLOSE ( 112 )
+  
+        !  If there are zero files, we are toast.
+        IF ( number_of_input_files .LE. 0 ) THEN
+           print*, ' Oops, we need at least ONE input file for the program to read.'
+           print*, '       Make sure you have the path, and name file(s) correct,'
+           print*, '       including wild characters if needed.'
+           STOP
+        END IF
+  
+        !  Allocate space for this many files.
+        ALLOCATE (  input_file_names(number_of_input_files) , STAT=ierr )
+        ALLOCATE ( output_file_names(number_of_input_files) , STAT=ierr )
+
+        !  Did the allocate work OK?
+        IF ( ierr .NE. 0 ) THEN
+           print*, ' tried to allocate ', number_of_input_files, ' input files, (look at ./foo)'
+           STOP
+        END IF
+
+        !  Initialize all of the file names to blank.
+         input_file_names = '                                                  ' // &
+                            '                                                  ' // &
+                            '                                '
+        output_file_names = '                                                  ' // &
+                            '                                                  ' // &
+                            '                                '
+  
+        !  Open the file that has the list of filenames.
+        OPEN (FILE   = '.foo'        , &
+              UNIT   = 111           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+  
+        !  Read all of the file names and store them.
+        DO loop = 1 , number_of_input_files
+           READ ( 111 , FMT='(A)' ) input_file_names(loop)
+           IF ( output_name == ' ' ) THEN
+              ilen = INDEX(TRIM(input_file_names(loop)),'/',.TRUE.) 
+              output_file_names(loop) = TRIM(path_to_output)//input_file_names(loop)(ilen+1:)
+              output_file_names(loop) = TRIM(output_file_names(loop))//"_PLEV"
+           ELSE
+              IF ( number_of_input_files == 1 ) THEN
+                 output_file_names(loop) = TRIM(path_to_output)//TRIM(output_name)
+              ELSE
+                 write(tmp_name,'(A,A,"_",I4.4)') TRIM(path_to_output), TRIM(output_name), loop
+                 output_file_names(loop) = tmp_name
+              ENDIF
+           ENDIF
+        END DO
+        CLOSE ( 112 )
+        print*, " " 
+  
+        !   We clean up our own messes.
+        CALL SYSTEM ( '/bin/rm -f .foo'  )
+        CALL SYSTEM ( '/bin/rm -f .foo1' )
+
+     
+        ! Do we have a list of field that we want on output?
+        process_these_fields = ','
+        IF ( INDEX(process,'list') /= 0) THEN
+          DO i = 1 , len(fields)
+            IF (fields(i:i) /= ' ' ) THEN
+              process_these_fields = trim(process_these_fields)//fields(i:i)
+            ENDIF
+          END DO
+          process_these_fields = trim(process_these_fields)//","
+        END IF
+
+
+
+      write(6,*) 
+      write(6,*) "##############################################################"
+      write(6,'(A,i4,A)') " RUNNING p_interp V1.0 on ", number_of_input_files, " file(s)."
+
+      LINLOG = interp_method
+      write(6,*) 
+      write(6,'(A,$)') " INTERPOLATION METHOD: "
+      IF ( LINLOG == 1 ) write(6,*) " linear in p"
+      IF ( LINLOG == 2 ) write(6,*) " linear in log p"
+      IF (extrapolate == 0) write(6,*)"BELOW GROUND will be set to missing values"
+      IF (extrapolate == 0) write(6,*)"ABOVE model top will be set to missing values"
+      IF (extrapolate == 1) write(6,*)"BELOW GROUND will be extrapolated"
+      IF (extrapolate == 1) write(6,*)"ABOVE model top will be set to values at model top"
+      IF (.not. unstagger_grid) write(6,*)"Data will be output on C-grid" 
+      IF (unstagger_grid) write(6,*)"Data will be output on unstaggered grid"
+
+
+      ! Find the pressure levels to interpolate to
+      write(6,*)
+      write(6,*) "INTERPOLATING TO PRESSURE LEVELS: "
+      num_metgrid_levels = 0
+      DO
+        IF (interp_levels(num_metgrid_levels+1) == -99999.) EXIT
+        num_metgrid_levels = num_metgrid_levels + 1
+        if (mod(num_metgrid_levels,8) /= 0 )write(6,'(f8.3,$)') interp_levels(num_metgrid_levels)
+        if (mod(num_metgrid_levels,8) == 0 )write(6,'(f8.3)') interp_levels(num_metgrid_levels)
+        interp_levels(num_metgrid_levels) = interp_levels(num_metgrid_levels) * 100.0   !!! Pa
+      END DO
+      write(6,*)
+      write(6,*)
+
+
+      DO loop = 1, number_of_input_files
+
+        IF (debug) write(6,*) "##############################################################"
+        input_file  = input_file_names(loop)
+        output_file = output_file_names(loop)
+
+        IF ( .not. debug ) write(6,*) " Output will be written to: ",trim(output_file)
+
+        IF (debug) THEN
+          write(6,*) " INPUT FILE:         ",trim(input_file)
+          write(6,*) " OUTPUT FILE:        ",trim(output_file)
+          write(6,*) "  "
+        ENDIF
+
+
+! OPEN INPUT AND OUTPUT FILE
+! output_file is input_file_new
+        rcode = nf_open(input_file, 0, ncid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        if (bit64) then
+          rcode = nf_create(output_file, NF_64BIT_OFFSET, mcid)
+        else
+          rcode = nf_create(output_file, 0, mcid)
+        endif
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+
+
+! GET BASIC INFORMTION ABOUT THE FILE
+! most important 
+!   ndims:  number of dimensions
+!   nvars:  number of variables
+!   ngatts: number of global attributes
+        rcode = nf_inq(ncid, ndims, nvars, ngatts, nunlimdimid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        IF (debug) THEN
+          write(6,*) ' INPUT file has = ',ndims, ' dimensions, '
+          write(6,*) '                  ',nvars, ' variables, and '      
+          write(6,*) '                  ',ngatts,' global attributes '
+          write(6,*) "  "
+        ENDIF
+        rcode = nf_get_att_int (ncid, nf_global, 'WEST-EAST_GRID_DIMENSION', iweg)
+        rcode = nf_get_att_int (ncid, nf_global, 'SOUTH-NORTH_GRID_DIMENSION', isng)
+        rcode = nf_get_att_int (ncid, nf_global, 'BOTTOM-TOP_GRID_DIMENSION', ibtg)
+
+
+
+! ALLOCATE SOME VARIABLES
+        IF (ALLOCATED(dnamei)) deallocate(dnamei)
+            ALLOCATE (dnamei(20))
+        IF (ALLOCATED(dnamej)) deallocate(dnamej)
+            ALLOCATE (dnamej(20))
+        IF (ALLOCATED(dvali)) deallocate(dvali)
+            ALLOCATE (dvali(20))
+        IF (ALLOCATED(dvalj)) deallocate(dvalj)
+            ALLOCATE (dvalj(20))
+
+
+! READ ALL DIMS FROM INPUT FILE AND CREATE SOME DIMS FOR OUTPUT FILE
+        j = 0
+        DO i = 1, ndims
+          rcode = nf_inq_dim(ncid, i, dnamei(i), dvali(i))
+  
+          IF ( dnamei(i) == "Time" ) THEN
+            j = j + 1
+            dnamej(j) = dnamei(i)
+            dvalj(j) = dvali(i)
+            rcode = nf_def_dim(mcid, dnamej(j), NF_UNLIMITED, j)
+            times_in_file  = dvali(i)
+          ENDIF 
+  
+        ENDDO
+
+        !!! Create a pressure dims
+        j = j + 1
+        dnamej(j) = 'num_metgrid_levels'
+        dvalj(j) = num_metgrid_levels
+        rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+        
+
+! DEALING WITH THE GLOBAL ATTRIBUTES
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) " OUTPUT FILE attributes:"
+        ENDIF
+        do i = 1, ngatts
+          rcode = nf_inq_attname(ncid, nf_global, i,    cname)
+          rcode = nf_inq_atttype(ncid, nf_global, cname, itype)
+          rcode = nf_inq_attlen (ncid, nf_global, cname, ilen)
+  
+	  if ( itype .eq. 2 ) then        ! characters
+	    rcode = nf_get_att_text (ncid, nf_global, cname, cval)
+	    if(cname(1:5) .eq. 'TITLE') then
+               cval = cval(1:ilen)//" - ON PRES LEVELS"
+               ilen = len_trim(cval)
+            endif
+            IF (debug) &
+	      write(6,'("     i = ",i2," : ",A," = ",A)') &
+                    i,cname,cval(1:ilen)
+	    rcode = nf_put_att_text(mcid, nf_global, cname, ilen,&
+                      cval(1:ilen))
+  
+	  elseif ( itype .eq. 4 ) then     ! integers
+	    rcode = nf_get_att_int (ncid, nf_global, cname, ival)
+            IF ( INDEX(cname,'BOTTOM-TOP_PATCH') == 0 ) THEN
+	       IF (cname .eq. 'BOTTOM-TOP_GRID_DIMENSION') ival = num_metgrid_levels
+               IF (debug) &
+	         write(6,'("     i = ",i2," : ",A," = ",i7)') &
+                       i,cname,ival        
+               rcode = nf_put_att_int(mcid, nf_global, cname, itype,&
+                         ilen, ival)
+             ENDIF
+  
+	  elseif ( itype .eq. 5 ) then    ! real
+	    rcode = nf_get_att_real (ncid, nf_global, cname, rval)
+            IF (debug) &
+	      write(6,'("     i = ",i2," : ",A," = ",G18.10E2)') &
+                    i,cname,rval
+	    rcode = nf_put_att_real(mcid, nf_global, cname, itype,&
+                      ilen, rval)
+	  end if
+        enddo
+
+rcode = nf_enddef(mcid)
+
+
+! WE NEED SOME BASIC FIELDS
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(times_in_file,1,1,1))
+         rcode = nf_inq_varid    ( ncid, "P_TOP", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         IF ( first ) THEN
+            IF ( extrapolate == 1 .AND. &
+                 (data1(1,1,1,1)-interp_levels(num_metgrid_levels)) > 0.0 ) THEN
+               write(6,*)
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+               write(6,*) " WARNING: Highest requested pressure level is above PTOP."
+               write(6,'(A,F7.2,A)') "           Use all pressure level data above", data1(1,1,1,1)*.01, " mb"
+               write(6,*) "          with caution."
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+            ENDIF
+            first = .FALSE.
+         ENDIF
+         deallocate (data1)
+
+         IF (ALLOCATED(pres_field)) deallocate(pres_field)
+         allocate (pres_field(iweg-1, isng-1, ibtg-1, times_in_file ))
+!!!!MARS MARS
+!         IF (ALLOCATED(data1)) deallocate(data1)
+!         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+!         rcode = nf_inq_varid    ( ncid, "P", i )
+!         rcode = nf_get_var_real ( ncid, i, pres_field )
+!         rcode = nf_inq_varid    ( ncid, "PB", i )
+!         rcode = nf_get_var_real ( ncid, i, data1 )
+!         pres_field = pres_field + data1
+         rcode = nf_inq_varid    ( ncid, "PTOT", i )
+         rcode = nf_get_var_real ( ncid, i, pres_field )
+!         deallocate (data1)
+
+         IF (ALLOCATED(pres_stagU)) deallocate(pres_stagU)
+         IF (ALLOCATED(pres_stagV)) deallocate(pres_stagV)
+         allocate (pres_stagU(iweg, isng-1, ibtg-1, times_in_file ))
+         allocate (pres_stagV(iweg-1, isng, ibtg-1, times_in_file ))
+         pres_stagU(1,:,:,:)        =  pres_field(1,:,:,:)
+         pres_stagU(iweg,:,:,:)     =  pres_field(iweg-1,:,:,:)
+         pres_stagU(2:iweg-1,:,:,:) = (pres_field(1:iweg-2,:,:,:) +    &
+                                       pres_field(2:iweg-1,:,:,:))*.5
+         pres_stagV(:,1,:,:)        =  pres_field(:,1,:,:)
+         pres_stagV(:,isng,:,:)     =  pres_field(:,isng-1,:,:)
+         pres_stagV(:,2:isng-1,:,:) = (pres_field(:,1:isng-2,:,:) +    &
+                                       pres_field(:,2:isng-1,:,:))*.5
+
+         IF (ALLOCATED(psfc)) deallocate(psfc)
+         allocate (psfc(iweg-1, isng-1, times_in_file ))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "PSFC", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         psfc(:,:,:) = data1(:,:,1,:)
+         deallocate (data1)
+
+         IF (ALLOCATED(pres_out)) deallocate(pres_out)
+         allocate (pres_out(iweg-1, isng-1, num_metgrid_levels, times_in_file))
+         do i = 1, num_metgrid_levels
+           pres_out (:,:,i,:) = interp_levels(i)
+         enddo
+         IF (ALLOCATED(ght)) deallocate(ght)
+         allocate (ght(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (ALLOCATED(phb)) deallocate(phb)
+         allocate (phb(iweg-1, isng-1, ibtg, times_in_file ))
+!!!!MARS MARS
+!         IF (ALLOCATED(data1)) deallocate(data1)
+!         allocate (data1(iweg-1, isng-1, ibtg, times_in_file ))
+!         rcode = nf_inq_varid    ( ncid, "PH", i )
+!         rcode = nf_get_var_real ( ncid, i, data1 )
+!         rcode = nf_inq_varid    ( ncid, "PHB", i )
+!         rcode = nf_get_var_real ( ncid, i, phb )
+!         data1 = (data1 + phb) 
+!         ght(:,:,1:ibtg-1,:) = ( data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:) )*.5
+!         deallocate (data1)
+         rcode = nf_inq_varid    ( ncid, "PHTOT", i )
+         rcode = nf_get_var_real ( ncid, i, phb )
+         ght(:,:,1:ibtg-1,:) = phb(:,:,1:ibtg-1,:)
+         deallocate (phb)
+
+         IF (ALLOCATED(ter)) deallocate(ter)
+         allocate (ter(iweg-1, isng-1))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "HGT", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         ter(:,:) = data1(:,:,1,1)
+         deallocate (data1)
+
+!!!! MARS MARS: not for the moment
+!         IF (ALLOCATED(qv)) deallocate(qv)
+!         allocate (qv(iweg-1, isng-1, ibtg-1, times_in_file ))
+!         rcode = nf_inq_varid    ( ncid, "QVAPOR", i )
+!         rcode = nf_get_var_real ( ncid, i, qv )
+
+
+         IF (ALLOCATED(tk)) deallocate(tk)
+         allocate (tk(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (ALLOCATED(tpot)) deallocate(tpot)
+         allocate (tpot(iweg-1, isng-1, ibtg-1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "T", i )
+         rcode = nf_get_var_real ( ncid, i, tpot )
+!!! MARS MARS MARS
+         tpot = tpot + 220.
+         tk = tpot * ( pres_field / p0 )**RCP
+!         deallocate (data1)
+
+!!!! MARS MARS: not for the moment
+!         IF (ALLOCATED(rh)) deallocate(rh)
+!         allocate (rh(iweg-1, isng-1, ibtg-1, times_in_file ))
+!         IF (ALLOCATED(data1)) deallocate(data1)
+!         IF (ALLOCATED(data2)) deallocate(data2)
+!         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+!         allocate (data2(iweg-1, isng-1, ibtg-1, times_in_file ))
+!!!! MARS MARS MARS: sera a changer !!!
+!         data1 = 10.*0.6112*exp(17.67*(tk-273.16)/(TK-29.65))
+!         data2 = 0.622*data1/(0.01 * pres_field -  (1.-0.622)*data1)
+!         rh    = 100.*AMAX1(AMIN1(qv/data2,1.0),0.0)
+!         deallocate (data1)
+!         deallocate (data2)
+
+
+
+! TRAIN FILE 
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) 
+          write(6,*) "FILE variables:"
+        ENDIF
+        jvar = 0
+        loop_variables : DO ivar = 1, nvars
+          rcode = nf_inq_var(ncid, ivar, cval, itype, idm, ishape, natt)
+
+!          !!! Do we want this variable
+!          IF ( trim(cval) == 'P'  .OR. trim(cval) == 'PB' )  CYCLE loop_variables
+!          IF ( trim(cval) == 'PH' .OR. trim(cval) == 'PHB' ) CYCLE loop_variables
+!!!MARS MARS
+          IF ( trim(cval) == 'PTOT' )  CYCLE loop_variables
+          IF ( trim(cval) == 'PHTOT' ) CYCLE loop_variables
+!          IF ( trim(cval) == 'T' ) CYCLE loop_variables
+          IF ( unstagger_grid .AND. (INDEX(cval,'_U') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( unstagger_grid .AND. (INDEX(cval,'_V') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( INDEX(process,'all') == 0 ) THEN
+             !!! Only want some variables - see which
+             dummy = ","//trim(cval)//","
+             is_there = INDEX(process_these_fields,trim(dummy))
+             IF ( is_there == 0 ) THEN
+                IF ( debug ) print*,"NOTE: ", trim(cval), " - Not requested"
+                CYCLE loop_variables !!! don't want this one
+             ENDIF
+          ENDIF
+
+          IF ( idm >= 4 .AND. itype == 4 ) THEN
+            print*,"NOTE: We cannot deal with 3D integers - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 6 ) THEN
+            print*,"NOTE: We cannot deal with double precision data - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 2 .OR. itype == 4 .OR. itype == 5 ) THEN
+            !!! OK I know what to do this this
+          ELSE
+            print*,"NOTE: Do not understand this data type ", itype, " skip field."
+            CYCLE loop_variables
+          ENDIF
+
+!!! MARS MARS
+          IF ( trim(cval) == 'U' )   cval = 'U' !'UU'
+          IF ( trim(cval) == 'V' )   cval = 'V' !'VV'
+          IF ( trim(cval) == 'T' )   cval = 'T'
+          !IF ( trim(cval) == 'TSK' ) cval = 'SKINTEMP'
+
+          !!! OK - we want this - lets continue
+          jvar = jvar + 1
+          jshape = 0
+          interpolate = .FALSE.
+          fix_meta_stag = .FALSE.
+          rcode = nf_redef(mcid)
+          DO ii = 1, idm
+            test_dim_name = dnamei(ishape(ii))
+            IF ( test_dim_name == 'bottom_top' .OR. test_dim_name == 'bottom_top_stag' ) THEN
+                 IF ( test_dim_name == 'bottom_top_stag' ) fix_meta_stag = .TRUE.
+                 test_dim_name = 'num_metgrid_levels'
+                 interpolate = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'west_east_stag' )   THEN
+               test_dim_name = 'west_east'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'south_north_stag' ) THEN
+               test_dim_name = 'south_north'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            DO jj = 1,j
+              IF ( test_dim_name == dnamej(jj) ) THEN
+                jshape(ii) = jj
+              ENDIF
+            ENDDO
+
+            IF ( jshape(ii) == 0 ) THEN
+              j = j + 1
+              jshape(ii) = j
+              dnamej(j) = dnamei(ishape(ii))
+              dvalj(j) = dvali(ishape(ii))
+              rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+            ENDIF
+          ENDDO
+          rcode = nf_def_var(mcid, cval, itype, idm, jshape, jvar)
+
+          DO na = 1, natt
+             rcode = nf_inq_attname(ncid, ivar, na, cname)
+             IF ( fix_meta_stag .AND. trim(cname) == 'stagger' ) THEN
+                att_text = "-"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSEIF ( fix_meta_stag .AND. trim(cname) == 'coordinates' ) THEN
+                att_text = "XLONG XLAT"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSE
+                rcode = nf_copy_att(ncid, ivar, cname, mcid, jvar)
+             ENDIF
+          ENDDO
+
+          IF ( extrapolate == 0 ) THEN
+            rcode = nf_put_att_real(mcid, jvar, 'missing_value', NF_FLOAT, 1, MISSING )
+          ENDIF
+
+          rcode = nf_enddef(mcid)
+
+
+
+! GET THE DIMS FOR INPUT AND OUTPUT FROM THE SHAPE
+          dims_in  = 1
+          dims_out = 1
+          DO ii = 1,idm
+            dims_in(ii)  = dvali(ishape(ii))
+            dims_out(ii) = dvalj(jshape(ii))
+          ENDDO
+          IF (debug) THEN
+            write(6,*) 'VAR: ',trim(cval)
+            write(6,*) '     DIMS  IN: ',dims_in
+            write(6,*) '     DIMS OUT: ',dims_out
+          ENDIF
+  
+
+
+! ALLOCATE THE INPUT AND OUTPUT ARRAYS
+! READ THE DATA FROM INPUT FILE
+
+	  IF     (itype == 2) THEN          ! character
+            allocate (text(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+	    rcode = nf_get_var_text(ncid, ivar, text)
+	    rcode = nf_put_vara_text (mcid, jvar, start_dims, dims_in, text)
+            IF (debug) write(6,*) '     SAMPLE VALUE = ',text(:,1,1,1)
+            deallocate (text)
+  
+  
+	  ELSEIF (itype == 4) THEN          ! integer
+            allocate (idata1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+	    rcode = nf_get_var_int(ncid, ivar, idata1)
+	    rcode = nf_put_vara_int (mcid, jvar, start_dims, dims_in, idata1)
+            IF (debug) write(6,*) '     SAMPLE VALUE = ',idata1(dims_in(1)/2,dims_in(2)/2,1,1)
+            deallocate (idata1)
+  
+  
+	  ELSEIF (itype == 5) THEN          ! real
+            allocate (data1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+            allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+	    rcode = nf_get_var_real(ncid, ivar, data1)
+  
+            IF (idm >= 4 .AND. interpolate) THEN  
+               IF (debug) write(6,*) '     THIS IS A FIELD WE NEED TO INTERPOLATE'       
+
+               IF ( dims_in(1) == iweg .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagU, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(2) == isng .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagV, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(1) == iweg .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(2) == isng .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(3) == ibtg ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(:,:,1:ibtg-1,:) = (data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSE
+                  CALL interp (data2, data1, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), dims_in(3), dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               END IF
+
+               IF (debug) write(6,*) '     SAMPLE VALUE IN  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+               IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+
+            ELSEIF (idm == 3 .AND. unstagger_grid ) THEN  
+               IF ( dims_in(1) == iweg ) THEN
+                  data2(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+               ELSEIF ( dims_in(2) == isng ) THEN
+                  data2(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+               ELSE
+	         data2 = data1
+               ENDIF
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+	    ELSE
+	       data2 = data1
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+	    ENDIF
+            
+	    rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+
+            deallocate (data1)
+            deallocate (data2)
+  
+  
+          ENDIF
+  
+        ENDDO loop_variables
+
+!!!! MARS MARS: have to correct bug, only one time occurence is output 
+!!! We have some special variables we are interested in: PRES, TT, GHT
+        IF ( debug ) print*," "
+        IF ( debug ) print*,"Calculatng some diagnostics"
+           
+        jshape = 0
+        DO ii = 1, 4
+          IF ( ii == 1 ) test_dim_name = 'west_east'
+          IF ( ii == 2 ) test_dim_name = 'south_north'
+          IF ( ii == 3 ) test_dim_name = 'num_metgrid_levels'
+          IF ( ii == 4 ) test_dim_name = 'Time'
+          DO jj = 1,j
+            IF ( test_dim_name == dnamej(jj) ) THEN
+              jshape(ii) = jj
+            ENDIF
+          ENDDO
+
+          IF ( jshape(ii) == 0 ) THEN
+            j = j + 1
+            jshape(ii) = j
+            dnamej(j) = dnamei(ishape(ii))
+            dvalj(j) = dvali(ishape(ii))
+            rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+          ENDIF
+        ENDDO
+        dims_in  = 1
+        dims_out = 1
+        DO ii = 1,4
+          dims_out(ii) = dvalj(jshape(ii))
+        ENDDO
+
+        interpolate = .TRUE.
+
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'PRES') /= 0 ) THEN
+           !!! PRES
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "PRES", 5, 4, jshape, "XZY", "Pressure           ", "Pa", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: PRES'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, pres_out)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',pres_out(dims_out(1)/2,dims_out(2)/2,1,1)
+        ENDIF
+
+!!!! MARS MARS: use tk 
+!        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'TT') /= 0 ) THEN
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'tk') /= 0 ) THEN
+           !!! TT
+           jvar = jvar + 1
+!           CALL def_var (mcid, jvar, "TT  ", 5, 4, jshape, "XZY", "Temperaturexxxxxxxxx", "K ", "-", "XLONG XLAT")
+           CALL def_var (mcid, jvar, "tk  ", 5, 4, jshape, "XZY", "Temperature         ", "K ", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: tk'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, tk, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+!        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'tpot') /= 0 ) THEN
+!           !!! tpot
+!           jvar = jvar + 1
+!           CALL def_var (mcid, jvar, "tpot", 5, 4, jshape, "XZY", "Potential Temperature ", "K ", "-", "XLONG XLAT")
+!           IF (debug) THEN
+!             write(6,*) 'VAR: tpot'
+!             write(6,*) '     DIMS OUT: ',dims_out
+!           ENDIF
+!           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+!           CALL interp (data2, tpot, pres_field, interp_levels, psfc, ter, tk, qv,  &
+!                          iweg-1, isng-1, ibtg-1, dims_in(4), &
+!                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+!           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+!           IF (debug) write(6,*) '     SAMPLE VALUE OUT =',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+!           deallocate(data2)
+!        ENDIF
+
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'GHT') /= 0 ) THEN
+           !!! GHT
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "GHT ", 5, 4, jshape, "XZY", "Geopotential Height", "m ", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: GHT'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, ght, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .TRUE., MISSING)
+!           data2 = data2/9.81
+           data2 = data2/3.72
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+!!!! MARS: no RH outputs for the moment
+!        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'RH') /= 0 ) THEN
+!           !!! RH
+!           jvar = jvar + 1
+!           CALL def_var (mcid, jvar, "RH  ", 5, 4, jshape, "XZY", "Relative Humidity  ", "% ", "-", "XLONG XLAT")
+!           IF (debug) THEN
+!             write(6,*) 'VAR: RH'
+!             write(6,*) '     DIMS OUT: ',dims_out
+!           ENDIF
+!           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+!           CALL interp (data2, rh, pres_field, interp_levels, psfc, ter, tk, qv,   &
+!                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+!                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+!           WHERE ( rh < 0.0 ) 
+!              rh = 0.0
+!           ENDWHERE
+!           WHERE ( rh > 100.0 )
+!              rh = 100.0
+!           ENDWHERE
+!           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+!           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+!           deallocate(data2)
+!        ENDIF
+
+
+!!! Close files on exit
+        rcode = nf_close(ncid)
+        rcode = nf_close(mcid)
+        write(6,*) 
+      ENDDO 
+
+  
+      write(6,*) 
+      write(6,*) "##############################################################"
+      write(6,*) " SUCCESS: We are out of here"      
+      write(6,*) "##############################################################"
+
+ END PROGRAM p_interp
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+ SUBROUTINE handle_err(rcode)
+    INTEGER rcode
+    write(6,*) 'Error number ',rcode
+    stop
+ END SUBROUTINE
+!---------------------------------------------------------------------
+ SUBROUTINE interp (data_out, data_in, pres_field, interp_levels, psfc, ter, tk, qv, ix, iy, iz, it, &
+                     num_metgrid_levels, LINLOG, extrapolate, GEOPT, MISSING)
+
+     INTEGER                                          :: ix, iy, iz, it
+     INTEGER                                          :: num_metgrid_levels, LINLOG
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: data_out
+     REAL, DIMENSION(ix, iy, iz, it)                  :: data_in, pres_field, tk, qv
+     REAL, DIMENSION(ix, iy, it)                      :: psfc
+     REAL, DIMENSION(ix, iy)                          :: ter
+     REAL, DIMENSION(num_metgrid_levels)              :: interp_levels
+
+     INTEGER                                          :: i, j, itt, k, kk, kin
+     REAL, DIMENSION(num_metgrid_levels)              :: data_out1D
+     REAL, DIMENSION(iz)                              :: data_in1D, pres_field1D
+     INTEGER                                          :: extrapolate
+     REAL                                             :: MISSING
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: N
+     REAL                                             :: sumA, sumN, AVE_geopt
+     LOGICAL                                          :: GEOPT
+
+     N = 1.0
+
+!!! MARS MARS MARS
+     !expon=287.04*.0065/9.81
+     expon=192.*.0045/3.72
+
+
+     do itt = 1, it
+        do j = 1, iy
+        do i = 1, ix
+           data_in1D(:)    = data_in(i,j,:,itt)
+           pres_field1D(:) = pres_field(i,j,:,itt)
+           CALL int1D (data_out1D, data_in1D, pres_field1D, interp_levels, iz, num_metgrid_levels, LINLOG, MISSING)
+           data_out(i,j,:,itt) = data_out1D(:)
+        end do
+        end do
+     end do
+
+
+     ! Fill in missing values
+     IF ( extrapolate == 0 ) RETURN       !! no extrapolation - we are out of here
+
+     ! First find where about 400 hPa is located
+     kk = 0
+     find_kk : do k = 1, num_metgrid_levels
+        kk = k
+        if ( interp_levels(k) <= 40000. ) exit find_kk
+     end do find_kk
+
+     
+     IF ( GEOPT ) THEN     !! geopt is treated different below ground
+
+        do itt = 1, it
+           do k = 1, kk
+              do j = 1, iy
+              do i = 1, ix
+                 IF ( data_out(i,j,k,itt) == MISSING .AND. interp_levels(k) < psfc(i,j,itt) ) THEN
+
+!                We are below the first model level, but above the ground 
+
+!!! MARS MARS
+                    data_out(i,j,k,itt) = ((interp_levels(k) - pres_field(i,j,1,itt))*ter(i,j)*3.72 +  &
+                                           (psfc(i,j,itt) - interp_levels(k))*data_in(i,j,1,itt) ) /   &
+                                          (psfc(i,j,itt) - pres_field(i,j,1,itt))
+
+                 ELSEIF ( data_out(i,j,k,itt) == MISSING ) THEN
+
+!                We are below both the ground and the lowest data level.
+
+!                First, find the model level that is closest to a "target" pressure
+!                level, where the "target" pressure is delta-p less that the local
+!                value of a horizontally smoothed surface pressure field.  We use
+!                delta-p = 150 hPa here. A standard lapse rate temperature profile
+!                passing through the temperature at this model level will be used
+!                to define the temperature profile below ground.  This is similar
+!                to the Benjamin and Miller (1990) method, except that for
+!                simplicity, they used 700 hPa everywhere for the "target" pressure.
+!                Code similar to what is implemented in RIP4
+
+
+!!! MARS MARS MARS
+                    ptarget = (psfc(i,j,itt)*.01) - 1.50 !150.
+                    dpmin=1.e2 !1.e4
+                    kupper = 0
+                    loop_kIN : do kin=iz,1,-1
+                       kupper = kin
+                       dp=abs( (pres_field(i,j,kin,itt)*.01) - ptarget )
+                       if (dp.gt.dpmin) exit loop_kIN
+                       dpmin=min(dpmin,dp)
+                    enddo loop_kIN
+
+                    pbot=max(pres_field(i,j,1,itt),psfc(i,j,itt))
+                    zbot=min(data_in(i,j,1,itt)/3.72,ter(i,j))   !!MARS MARS
+
+                    tbotextrap=tk(i,j,kupper,itt)*(pbot/pres_field(i,j,kupper,itt))**expon
+                    tvbotextrap=virtual(tbotextrap,qv(i,j,1,itt))
+
+                    data_out(i,j,k,itt) = (zbot+tvbotextrap/.0045*(1.-(interp_levels(k)/pbot)**expon))*3.72   !!MARS MARS
+               
+                 ENDIF
+              enddo
+              enddo
+           enddo
+        enddo
+
+
+        !!! Code for filling missing data with an average - we don't want to do this
+        !!do itt = 1, it
+           !!loop_levels : do k = 1, num_metgrid_levels
+              !!sumA = SUM(data_out(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!sumN = SUM(N(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!IF ( sumN == 0. ) CYCLE loop_levels
+              !!AVE_geopt = sumA/sumN
+              !!WHERE ( data_out(:,:,k,itt) == MISSING )
+                 !!data_out(:,:,k,itt) = AVE_geopt
+              !!END WHERE
+           !!end do loop_levels
+        !!end do
+
+     END IF
+     
+     !!! All other fields and geopt at higher levels come here
+     do itt = 1, it
+        do j = 1, iy
+        do i = 1, ix
+          do k = 1, kk
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,1,itt)
+          end do
+          do k = kk+1, num_metgrid_levels
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,iz,itt)
+          end do
+        end do
+        end do
+     end do
+       
+
+ END SUBROUTINE interp 
+!------------------------------------------------------------------------------
+!--------------------------------------------------------
+ SUBROUTINE int1D(xxout, xxin, ppin, ppout, npin, npout, LINLOG, MISSING)
+
+! Modified from int2p - NCL code
+! routine to interpolate from one set of pressure levels
+! .   to another set  using linear or ln(p) interpolation
+!
+! NCL: xout = int2p (pin,xin,pout,linlog)
+! This code was originally written for a specific purpose.
+! .   Several features were added for incorporation into NCL's
+! .   function suite including linear extrapolation.
+!
+! nomenclature:
+!
+! .   ppin   - input pressure levels. The pin can be
+! .            be in ascending or descending order
+! .   xxin   - data at corresponding input pressure levels
+! .   npin   - number of input pressure levels >= 2
+! .   ppout  - output pressure levels (input by user)
+! .            same (ascending or descending) order as pin
+! .   xxout  - data at corresponding output pressure levels
+! .   npout  - number of output pressure levels
+! .   linlog - if abs(linlog)=1 use linear interp in pressure
+! .            if abs(linlog)=2 linear interp in ln(pressure)
+! .   missing- missing data code. 
+
+!                                                ! input types
+      INTEGER   :: npin,npout,linlog,ier
+      real      :: ppin(npin),xxin(npin),ppout(npout)
+      real      :: MISSING       
+     logical                                          :: AVERAGE
+!                                                ! output
+      real      :: xxout(npout)
+      INTEGER   :: j1,np,nl,nin,nlmax,nplvl
+      INTEGER   :: nlsave,np1,no1,n1,n2,nlstrt
+      real      :: slope,pa,pb,pc
+
+! automatic arrays
+      real      :: pin(npin),xin(npin),p(npin),x(npin)
+      real      :: pout(npout),xout(npout)
+
+
+      xxout = MISSING
+      pout  = ppout
+      p     = ppin
+      x     = xxin
+      nlmax = npin
+
+! exact p-level matches
+      nlstrt = 1
+      nlsave = 1
+      do np = 1,npout
+          xout(np) = MISSING
+          do nl = nlstrt,nlmax
+              if (pout(np).eq.p(nl)) then
+                  xout(np) = x(nl)
+                  nlsave = nl + 1
+                  go to 10
+              end if
+          end do
+   10     nlstrt = nlsave
+      end do
+
+      if (LINLOG.eq.1) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      slope = (x(nl)-x(nl+1))/ (p(nl)-p(nl+1))
+                      xout(np) = x(nl+1) + slope* (pout(np)-p(nl+1))
+                  end if
+              end do
+          end do
+      elseif (LINLOG.eq.2) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      pa = log(p(nl))
+                      pb = log(pout(np))
+! special case: in case someone inadvertently enter p=0.
+                      if (p(nl+1).gt.0.d0) then
+                          pc = log(p(nl+1))
+                      else
+                          pc = log(1.d-4)
+                      end if
+
+                      slope = (x(nl)-x(nl+1))/ (pa-pc)
+                      xout(np) = x(nl+1) + slope* (pb-pc)
+                  end if
+              end do
+          end do
+      end if
+
+
+! place results in the return array;
+      xxout = xout
+
+ END SUBROUTINE int1D
+
+!------------------------------------------------------------------------------
+ FUNCTION virtual (tmp,rmix)
+!      This function returns virtual temperature in K, given temperature
+!      in K and mixing ratio in kg/kg.
+
+     real                              :: tmp, rmix, virtual
+
+     virtual=tmp*(0.622+rmix)/(0.622*(1.+rmix))
+
+ END FUNCTION virtual
+
+!------------------------------------------------------------------------------
+ SUBROUTINE all_spaces ( command , length_of_char ) 
+
+      IMPLICIT NONE
+
+      INTEGER                                       :: length_of_char
+      CHARACTER (LEN=length_of_char)                :: command
+      INTEGER                                       :: loop
+
+      DO loop = 1 , length_of_char
+         command(loop:loop) = ' '
+      END DO
+
+ END SUBROUTINE all_spaces
+
+!------------------------------------------------------------------------------
+ SUBROUTINE def_var (mcid, jvar, cval, itype, idm, jshape, order, desc, units, stag, coord )
+
+      IMPLICIT NONE
+
+      INCLUDE 'netcdf.inc'
+
+      INTEGER              :: mcid, jvar
+      CHARACTER (LEN =  4) :: cval
+      INTEGER              :: itype, idm
+      REAL, DIMENSION(6)   :: jshape
+      CHARACTER (LEN =  3) :: order
+      CHARACTER (LEN = 19) :: desc
+      CHARACTER (LEN =  2) :: units
+      CHARACTER (LEN =  1) :: stag
+      CHARACTER (LEN = 10) :: coord
+
+      INTEGER            :: rcode, ilen
+      CHARACTER (LEN=30) :: att_text
+
+
+      IF ( itype == 5 ) THEN
+         rcode = nf_redef(mcid)
+         rcode = nf_def_var(mcid, trim(cval), NF_REAL, idm, jshape, jvar)
+         rcode = nf_put_att_int(mcid, jvar, "FieldType", NF_INT, 1, 104)
+      ENDIF
+
+      att_text = order
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "MemoryOrder", ilen, att_text(1:ilen) )
+
+      att_text = desc
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "description", ilen, att_text(1:ilen) )
+
+      att_text = units
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "units", ilen, att_text(1:ilen) )
+
+      att_text = stag
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "stagger", ilen, att_text(1:ilen) )
+
+      att_text = coord
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "coordinates", ilen, att_text(1:ilen) )
+
+      rcode = nf_enddef(mcid)
+
+ END SUBROUTINE def_var
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_ok.F90
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_ok.F90	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/obsolete/p_interp_ok.F90	(revision 19)
@@ -0,0 +1,1173 @@
+ PROGRAM p_interp
+!  Program to read wrfout data and interpolate to pressure levels
+!  The program reads namelist.pinterp
+!  November 2007 - Cindy Bruyere
+!
+!=================================Make Executable============================
+!  Make executable:
+!    DEC Alpha
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o p_interp
+!
+!   Linux flags
+!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+!
+!   Sun flags
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o p_interp
+!
+!   SGI flags
+!      f90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -freeform  -o p_interp
+!
+!   IBM flags 
+!      xlf p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -qfree=f90  -o p_interp
+!
+!   Mac flags (with xlf compiler)
+!      xlf p_interp.F90 -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o p_interp
+!
+!   Mac flags (with g95 compiler)
+!	g95 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!	-I/usr/local/netcdf/include -ffree-form -o p_interp
+!
+!   Mac flags (with pgf90 compiler)
+!      pgf90 p_interp.F90 -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o p_interp
+!
+!============================================================================
+
+      IMPLICIT NONE
+      
+      INCLUDE 'netcdf.inc'
+
+!      REAL, PARAMETER                                    :: Rd = 287.04
+!      REAL, PARAMETER                                    :: Cp = 7.*Rd/2.
+!      REAL, PARAMETER                                    :: RCP = Rd/Cp
+!      REAL, PARAMETER                                    :: p0 = 100000.
+
+!!! MARS MARS MARS
+       REAL, PARAMETER :: Rd          = 192.    ! gas constant m2 s-2 K-1
+       REAL, PARAMETER :: Cp          = 844.6   ! r= 8.314511E+0*1000.E+0/mugaz
+       REAL, PARAMETER :: RCP = Rd/Cp
+       REAL, PARAMETER :: p0 = 610.
+
+
+
+      CHARACTER,         ALLOCATABLE, DIMENSION(:,:,:,:) :: text
+      CHARACTER (LEN=31),ALLOCATABLE, DIMENSION(:)       :: dnamei, dnamej
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: input_file_names
+      CHARACTER(LEN=250),ALLOCATABLE, DIMENSION(:)       :: output_file_names
+      DOUBLE PRECISION,  ALLOCATABLE, DIMENSION(:,:,:,:) :: ddata1, ddata2
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: data1, data2, data3
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_field, pres_out
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: pres_stagU, pres_stagV
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:,:) :: ght, phb, qv, tk, rh
+      REAL,              ALLOCATABLE, DIMENSION(:,:,:)   :: psfc
+      REAL,              ALLOCATABLE, DIMENSION(:,:)     :: ter
+      INTEGER,           ALLOCATABLE, DIMENSION(:)       :: dvali, dvalj
+      INTEGER,           ALLOCATABLE, DIMENSION(:,:,:,:) :: idata1, idata2
+      INTEGER,                        DIMENSION(4)       :: start_dims = 1
+      INTEGER,                        DIMENSION(4)       :: dims_in, dims_out
+      INTEGER,                        DIMENSION(6)       :: ishape, jshape
+
+      CHARACTER (LEN=80)                                 :: cval
+      CHARACTER (LEN=31)                                 :: cname, test_dim_name
+      CHARACTER (LEN=80)                                 :: input_file, output_file, att_text
+      CHARACTER (LEN=250)                                :: path_to_input
+      CHARACTER (LEN=250)                                :: path_to_output
+      CHARACTER (LEN=250)                                :: input_name
+      CHARACTER (LEN=250)                                :: output_name, tmp_name
+      CHARACTER (LEN=10)                                 :: option
+      CHARACTER (LEN=132)                                :: command
+      CHARACTER (LEN=20)                                 :: process, dummy
+      CHARACTER (LEN=2000)                               :: fields, process_these_fields
+      REAL, DIMENSION(99)                                :: interp_levels
+      REAL                                               :: rval
+      REAL                                               :: MISSING=1.e36
+      INTEGER                                            :: LINLOG = 1
+      INTEGER                                            :: interp_method=1
+      INTEGER                                            :: extrapolate=0
+      INTEGER                                            :: ncid, mcid, rcode
+      INTEGER                                            :: idm, ndims, nvars, natt, ngatts
+      INTEGER                                            :: nunlimdimid
+      INTEGER                                            :: i, ii, j, jj, ix, iy, iweg, isng, ibtg
+      INTEGER                                            :: ivar, jvar
+      INTEGER                                            :: times_in_file
+      INTEGER                                            :: ilen, itype, ival, na, funit, ios
+      INTEGER                                            :: num_metgrid_levels
+      INTEGER                                            :: number_of_input_files
+      INTEGER                                            :: ierr, loop, loslen, strlen, lent
+      INTEGER                                            :: is_there
+      LOGICAL                                            :: is_used
+      LOGICAL                                            :: debug=.FALSE.
+      LOGICAL                                            :: interpolate=.FALSE.
+      LOGICAL                                            :: unstagger_grid=.FALSE.
+      LOGICAL                                            :: fix_meta_stag=.FALSE.
+      LOGICAL                                            :: bit64=.FALSE.
+      LOGICAL                                            :: first=.TRUE.
+
+      NAMELIST /io/ path_to_input, input_name, path_to_output, output_name, &
+                    process, fields, debug, bit64
+      NAMELIST /interp_in/ interp_levels, interp_method, extrapolate, unstagger_grid
+
+      path_to_input   = './'
+      path_to_output  = './'
+      output_name     = ' '
+      interp_levels   = -99999.
+      process         = 'all'
+
+
+      ! Read parameters from Fortran namelist
+        DO funit=10,100
+           INQUIRE(unit=funit, opened=is_used)
+           IF (.not. is_used) EXIT
+        END DO
+        OPEN(funit,file='namelist.pinterp',status='old',form='formatted',iostat=ios)
+        IF ( ios /= 0 ) STOP "ERROR opening namelits.pinterp"
+        READ(funit,io)
+        READ(funit,interp_in)
+        CLOSE(funit)
+
+
+      ! Get all the input file names
+
+        lent = len_trim(path_to_input)
+        IF ( path_to_input(lent:lent) /= "/" ) THEN
+           path_to_input = TRIM(path_to_input)//"/"
+        ENDIF
+        lent = len_trim(path_to_output)
+        IF ( path_to_output(lent:lent) /= "/" ) THEN
+           path_to_output = TRIM(path_to_output)//"/"
+        ENDIF
+
+        input_name = TRIM(path_to_input)//TRIM(input_name)
+
+
+        !  Build a UNIX command, and "ls", of all of the input files 
+        loslen = LEN ( command )
+        CALL all_spaces ( command , loslen ) 
+        WRITE ( command , FMT='("ls -1 ",A," > .foo")' ) TRIM ( input_name )
+           
+        !  We stuck all of the matching files in the ".foo" file.  Now we place the 
+        !  number of the those file (i.e. how many there are) in ".foo1". 
+  
+        CALL SYSTEM ( TRIM ( command ) ) 
+        CALL SYSTEM ( '( cat .foo | wc -l > .foo1 )' )
+  
+        !  Read the number of files.
+        OPEN (FILE   = '.foo1'       , &
+              UNIT   = 112           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+  
+        READ ( 112 , * ) number_of_input_files
+        CLOSE ( 112 )
+  
+        !  If there are zero files, we are toast.
+        IF ( number_of_input_files .LE. 0 ) THEN
+           print*, ' Oops, we need at least ONE input file for the program to read.'
+           print*, '       Make sure you have the path, and name file(s) correct,'
+           print*, '       including wild characters if needed.'
+           STOP
+        END IF
+  
+        !  Allocate space for this many files.
+        ALLOCATE (  input_file_names(number_of_input_files) , STAT=ierr )
+        ALLOCATE ( output_file_names(number_of_input_files) , STAT=ierr )
+
+        !  Did the allocate work OK?
+        IF ( ierr .NE. 0 ) THEN
+           print*, ' tried to allocate ', number_of_input_files, ' input files, (look at ./foo)'
+           STOP
+        END IF
+
+        !  Initialize all of the file names to blank.
+         input_file_names = '                                                  ' // &
+                            '                                                  ' // &
+                            '                                '
+        output_file_names = '                                                  ' // &
+                            '                                                  ' // &
+                            '                                '
+  
+        !  Open the file that has the list of filenames.
+        OPEN (FILE   = '.foo'        , &
+              UNIT   = 111           , &
+              STATUS = 'OLD'         , &
+              ACCESS = 'SEQUENTIAL'  , &
+              FORM   = 'FORMATTED'     )
+  
+        !  Read all of the file names and store them.
+        DO loop = 1 , number_of_input_files
+           READ ( 111 , FMT='(A)' ) input_file_names(loop)
+           IF ( output_name == ' ' ) THEN
+              ilen = INDEX(TRIM(input_file_names(loop)),'/',.TRUE.) 
+              output_file_names(loop) = TRIM(path_to_output)//input_file_names(loop)(ilen+1:)
+              output_file_names(loop) = TRIM(output_file_names(loop))//"_PLEV"
+           ELSE
+              IF ( number_of_input_files == 1 ) THEN
+                 output_file_names(loop) = TRIM(path_to_output)//TRIM(output_name)
+              ELSE
+                 write(tmp_name,'(A,A,"_",I4.4)') TRIM(path_to_output), TRIM(output_name), loop
+                 output_file_names(loop) = tmp_name
+              ENDIF
+           ENDIF
+        END DO
+        CLOSE ( 112 )
+        print*, " " 
+  
+        !   We clean up our own messes.
+        CALL SYSTEM ( '/bin/rm -f .foo'  )
+        CALL SYSTEM ( '/bin/rm -f .foo1' )
+
+     
+        ! Do we have a list of field that we want on output?
+        process_these_fields = ','
+        IF ( INDEX(process,'list') /= 0) THEN
+          DO i = 1 , len(fields)
+            IF (fields(i:i) /= ' ' ) THEN
+              process_these_fields = trim(process_these_fields)//fields(i:i)
+            ENDIF
+          END DO
+          process_these_fields = trim(process_these_fields)//","
+        END IF
+
+
+
+      write(6,*) 
+      write(6,*) "##############################################################"
+      write(6,'(A,i4,A)') " RUNNING p_interp V1.0 on ", number_of_input_files, " file(s)."
+
+      LINLOG = interp_method
+      write(6,*) 
+      write(6,'(A,$)') " INTERPOLATION METHOD: "
+      IF ( LINLOG == 1 ) write(6,*) " linear in p"
+      IF ( LINLOG == 2 ) write(6,*) " linear in log p"
+      IF (extrapolate == 0) write(6,*)"BELOW GROUND will be set to missing values"
+      IF (extrapolate == 0) write(6,*)"ABOVE model top will be set to missing values"
+      IF (extrapolate == 1) write(6,*)"BELOW GROUND will be extrapolated"
+      IF (extrapolate == 1) write(6,*)"ABOVE model top will be set to values at model top"
+      IF (.not. unstagger_grid) write(6,*)"Data will be output on C-grid" 
+      IF (unstagger_grid) write(6,*)"Data will be output on unstaggered grid"
+
+
+      ! Find the pressure levels to interpolate to
+      write(6,*)
+      write(6,*) "INTERPOLATING TO PRESSURE LEVELS: "
+      num_metgrid_levels = 0
+      DO
+        IF (interp_levels(num_metgrid_levels+1) == -99999.) EXIT
+        num_metgrid_levels = num_metgrid_levels + 1
+        if (mod(num_metgrid_levels,8) /= 0 )write(6,'(f8.3,$)') interp_levels(num_metgrid_levels)
+        if (mod(num_metgrid_levels,8) == 0 )write(6,'(f8.3)') interp_levels(num_metgrid_levels)
+        interp_levels(num_metgrid_levels) = interp_levels(num_metgrid_levels) * 100.0   !!! Pa
+      END DO
+      write(6,*)
+      write(6,*)
+
+
+      DO loop = 1, number_of_input_files
+
+        IF (debug) write(6,*) "##############################################################"
+        input_file  = input_file_names(loop)
+        output_file = output_file_names(loop)
+
+        IF ( .not. debug ) write(6,*) " Output will be written to: ",trim(output_file)
+
+        IF (debug) THEN
+          write(6,*) " INPUT FILE:         ",trim(input_file)
+          write(6,*) " OUTPUT FILE:        ",trim(output_file)
+          write(6,*) "  "
+        ENDIF
+
+
+! OPEN INPUT AND OUTPUT FILE
+! output_file is input_file_new
+        rcode = nf_open(input_file, 0, ncid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        if (bit64) then
+          rcode = nf_create(output_file, NF_64BIT_OFFSET, mcid)
+        else
+          rcode = nf_create(output_file, 0, mcid)
+        endif
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+
+
+! GET BASIC INFORMTION ABOUT THE FILE
+! most important 
+!   ndims:  number of dimensions
+!   nvars:  number of variables
+!   ngatts: number of global attributes
+        rcode = nf_inq(ncid, ndims, nvars, ngatts, nunlimdimid)
+        if (rcode .ne. nf_noerr) call handle_err(rcode)
+        IF (debug) THEN
+          write(6,*) ' INPUT file has = ',ndims, ' dimensions, '
+          write(6,*) '                  ',nvars, ' variables, and '      
+          write(6,*) '                  ',ngatts,' global attributes '
+          write(6,*) "  "
+        ENDIF
+        rcode = nf_get_att_int (ncid, nf_global, 'WEST-EAST_GRID_DIMENSION', iweg)
+        rcode = nf_get_att_int (ncid, nf_global, 'SOUTH-NORTH_GRID_DIMENSION', isng)
+        rcode = nf_get_att_int (ncid, nf_global, 'BOTTOM-TOP_GRID_DIMENSION', ibtg)
+
+
+
+! ALLOCATE SOME VARIABLES
+        IF (ALLOCATED(dnamei)) deallocate(dnamei)
+            ALLOCATE (dnamei(20))
+        IF (ALLOCATED(dnamej)) deallocate(dnamej)
+            ALLOCATE (dnamej(20))
+        IF (ALLOCATED(dvali)) deallocate(dvali)
+            ALLOCATE (dvali(20))
+        IF (ALLOCATED(dvalj)) deallocate(dvalj)
+            ALLOCATE (dvalj(20))
+
+
+! READ ALL DIMS FROM INPUT FILE AND CREATE SOME DIMS FOR OUTPUT FILE
+        j = 0
+        DO i = 1, ndims
+          rcode = nf_inq_dim(ncid, i, dnamei(i), dvali(i))
+  
+          IF ( dnamei(i) == "Time" ) THEN
+            j = j + 1
+            dnamej(j) = dnamei(i)
+            dvalj(j) = dvali(i)
+            rcode = nf_def_dim(mcid, dnamej(j), NF_UNLIMITED, j)
+            times_in_file  = dvali(i)
+          ENDIF 
+  
+        ENDDO
+
+        !!! Create a pressure dims
+        j = j + 1
+        dnamej(j) = 'num_metgrid_levels'
+        dvalj(j) = num_metgrid_levels
+        rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+        
+
+! DEALING WITH THE GLOBAL ATTRIBUTES
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) " OUTPUT FILE attributes:"
+        ENDIF
+        do i = 1, ngatts
+          rcode = nf_inq_attname(ncid, nf_global, i,    cname)
+          rcode = nf_inq_atttype(ncid, nf_global, cname, itype)
+          rcode = nf_inq_attlen (ncid, nf_global, cname, ilen)
+  
+	  if ( itype .eq. 2 ) then        ! characters
+	    rcode = nf_get_att_text (ncid, nf_global, cname, cval)
+	    if(cname(1:5) .eq. 'TITLE') then
+               cval = cval(1:ilen)//" - ON PRES LEVELS"
+               ilen = len_trim(cval)
+            endif
+            IF (debug) &
+	      write(6,'("     i = ",i2," : ",A," = ",A)') &
+                    i,cname,cval(1:ilen)
+	    rcode = nf_put_att_text(mcid, nf_global, cname, ilen,&
+                      cval(1:ilen))
+  
+	  elseif ( itype .eq. 4 ) then     ! integers
+	    rcode = nf_get_att_int (ncid, nf_global, cname, ival)
+            IF ( INDEX(cname,'BOTTOM-TOP_PATCH') == 0 ) THEN
+	       IF (cname .eq. 'BOTTOM-TOP_GRID_DIMENSION') ival = num_metgrid_levels
+               IF (debug) &
+	         write(6,'("     i = ",i2," : ",A," = ",i7)') &
+                       i,cname,ival        
+               rcode = nf_put_att_int(mcid, nf_global, cname, itype,&
+                         ilen, ival)
+             ENDIF
+  
+	  elseif ( itype .eq. 5 ) then    ! real
+	    rcode = nf_get_att_real (ncid, nf_global, cname, rval)
+            IF (debug) &
+	      write(6,'("     i = ",i2," : ",A," = ",G18.10E2)') &
+                    i,cname,rval
+	    rcode = nf_put_att_real(mcid, nf_global, cname, itype,&
+                      ilen, rval)
+	  end if
+        enddo
+
+rcode = nf_enddef(mcid)
+
+
+! WE NEED SOME BASIC FIELDS
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(times_in_file,1,1,1))
+         rcode = nf_inq_varid    ( ncid, "P_TOP", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         IF ( first ) THEN
+            IF ( extrapolate == 1 .AND. &
+                 (data1(1,1,1,1)-interp_levels(num_metgrid_levels)) > 0.0 ) THEN
+               write(6,*)
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+               write(6,*) " WARNING: Highest requested pressure level is above PTOP."
+               write(6,'(A,F7.2,A)') "           Use all pressure level data above", data1(1,1,1,1)*.01, " mb"
+               write(6,*) "          with caution."
+               write(6,*) "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++"
+            ENDIF
+            first = .FALSE.
+         ENDIF
+         deallocate (data1)
+
+         IF (ALLOCATED(pres_field)) deallocate(pres_field)
+         allocate (pres_field(iweg-1, isng-1, ibtg-1, times_in_file ))
+!!!!MARS MARS
+!         IF (ALLOCATED(data1)) deallocate(data1)
+!         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+!         rcode = nf_inq_varid    ( ncid, "P", i )
+!         rcode = nf_get_var_real ( ncid, i, pres_field )
+!         rcode = nf_inq_varid    ( ncid, "PB", i )
+!         rcode = nf_get_var_real ( ncid, i, data1 )
+!         pres_field = pres_field + data1
+         rcode = nf_inq_varid    ( ncid, "PTOT", i )
+         rcode = nf_get_var_real ( ncid, i, pres_field )
+!         deallocate (data1)
+
+         IF (ALLOCATED(pres_stagU)) deallocate(pres_stagU)
+         IF (ALLOCATED(pres_stagV)) deallocate(pres_stagV)
+         allocate (pres_stagU(iweg, isng-1, ibtg-1, times_in_file ))
+         allocate (pres_stagV(iweg-1, isng, ibtg-1, times_in_file ))
+         pres_stagU(1,:,:,:)        =  pres_field(1,:,:,:)
+         pres_stagU(iweg,:,:,:)     =  pres_field(iweg-1,:,:,:)
+         pres_stagU(2:iweg-1,:,:,:) = (pres_field(1:iweg-2,:,:,:) +    &
+                                       pres_field(2:iweg-1,:,:,:))*.5
+         pres_stagV(:,1,:,:)        =  pres_field(:,1,:,:)
+         pres_stagV(:,isng,:,:)     =  pres_field(:,isng-1,:,:)
+         pres_stagV(:,2:isng-1,:,:) = (pres_field(:,1:isng-2,:,:) +    &
+                                       pres_field(:,2:isng-1,:,:))*.5
+
+         IF (ALLOCATED(psfc)) deallocate(psfc)
+         allocate (psfc(iweg-1, isng-1, times_in_file ))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "PSFC", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         psfc(:,:,:) = data1(:,:,1,:)
+         deallocate (data1)
+
+         IF (ALLOCATED(pres_out)) deallocate(pres_out)
+         allocate (pres_out(iweg-1, isng-1, num_metgrid_levels, times_in_file))
+         do i = 1, num_metgrid_levels
+           pres_out (:,:,i,:) = interp_levels(i)
+         enddo
+         IF (ALLOCATED(ght)) deallocate(ght)
+         allocate (ght(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (ALLOCATED(phb)) deallocate(phb)
+         allocate (phb(iweg-1, isng-1, ibtg, times_in_file ))
+!!!!MARS MARS
+!         IF (ALLOCATED(data1)) deallocate(data1)
+!         allocate (data1(iweg-1, isng-1, ibtg, times_in_file ))
+!         rcode = nf_inq_varid    ( ncid, "PH", i )
+!         rcode = nf_get_var_real ( ncid, i, data1 )
+!         rcode = nf_inq_varid    ( ncid, "PHB", i )
+!         rcode = nf_get_var_real ( ncid, i, phb )
+!         data1 = (data1 + phb) 
+!         ght(:,:,1:ibtg-1,:) = ( data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:) )*.5
+!         deallocate (data1)
+         rcode = nf_inq_varid    ( ncid, "PHTOT", i )
+         rcode = nf_get_var_real ( ncid, i, phb )
+         ght(:,:,1:ibtg-1,:) = phb(:,:,1:ibtg-1,:)
+         deallocate (phb)
+
+         IF (ALLOCATED(ter)) deallocate(ter)
+         allocate (ter(iweg-1, isng-1))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, 1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "HGT", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+         ter(:,:) = data1(:,:,1,1)
+         deallocate (data1)
+
+
+         IF (ALLOCATED(qv)) deallocate(qv)
+         allocate (qv(iweg-1, isng-1, ibtg-1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "QVAPOR", i )
+         rcode = nf_get_var_real ( ncid, i, qv )
+
+
+         IF (ALLOCATED(tk)) deallocate(tk)
+         allocate (tk(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+         rcode = nf_inq_varid    ( ncid, "T", i )
+         rcode = nf_get_var_real ( ncid, i, data1 )
+!!! MARS MARS MARS
+         tk = (data1+220.) * ( pres_field / p0 )**RCP
+         deallocate (data1)
+
+
+         IF (ALLOCATED(rh)) deallocate(rh)
+         allocate (rh(iweg-1, isng-1, ibtg-1, times_in_file ))
+         IF (ALLOCATED(data1)) deallocate(data1)
+         IF (ALLOCATED(data2)) deallocate(data2)
+         allocate (data1(iweg-1, isng-1, ibtg-1, times_in_file ))
+         allocate (data2(iweg-1, isng-1, ibtg-1, times_in_file ))
+!!! MARS MARS MARS: sera a changer !!!
+         data1 = 10.*0.6112*exp(17.67*(tk-273.16)/(TK-29.65))
+         data2 = 0.622*data1/(0.01 * pres_field -  (1.-0.622)*data1)
+         rh    = 100.*AMAX1(AMIN1(qv/data2,1.0),0.0)
+         deallocate (data1)
+         deallocate (data2)
+
+
+
+! TRAIN FILE 
+        IF (debug) THEN
+          write(6,*) 
+          write(6,*) 
+          write(6,*) "FILE variables:"
+        ENDIF
+        jvar = 0
+        loop_variables : DO ivar = 1, nvars
+          rcode = nf_inq_var(ncid, ivar, cval, itype, idm, ishape, natt)
+
+!          !!! Do we want this variable
+!          IF ( trim(cval) == 'P'  .OR. trim(cval) == 'PB' )  CYCLE loop_variables
+!          IF ( trim(cval) == 'PH' .OR. trim(cval) == 'PHB' ) CYCLE loop_variables
+!!!MARS MARS
+          IF ( trim(cval) == 'PTOT' )  CYCLE loop_variables
+          IF ( trim(cval) == 'PHTOT' ) CYCLE loop_variables
+          IF ( trim(cval) == 'T' ) CYCLE loop_variables
+          IF ( unstagger_grid .AND. (INDEX(cval,'_U') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( unstagger_grid .AND. (INDEX(cval,'_V') /= 0) ) CYCLE loop_variables !!! no sense in keeping these
+          IF ( INDEX(process,'all') == 0 ) THEN
+             !!! Only want some variables - see which
+             dummy = ","//trim(cval)//","
+             is_there = INDEX(process_these_fields,trim(dummy))
+             IF ( is_there == 0 ) THEN
+                IF ( debug ) print*,"NOTE: ", trim(cval), " - Not requested"
+                CYCLE loop_variables !!! don't want this one
+             ENDIF
+          ENDIF
+
+          IF ( idm >= 4 .AND. itype == 4 ) THEN
+            print*,"NOTE: We cannot deal with 3D integers - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 6 ) THEN
+            print*,"NOTE: We cannot deal with double precision data - maybe later"
+            CYCLE loop_variables
+          ENDIF
+          IF ( itype == 2 .OR. itype == 4 .OR. itype == 5 ) THEN
+            !!! OK I know what to do this this
+          ELSE
+            print*,"NOTE: Do not understand this data type ", itype, " skip field."
+            CYCLE loop_variables
+          ENDIF
+
+!!! MARS MARS
+          IF ( trim(cval) == 'U' )   cval = 'U' !'UU'
+          IF ( trim(cval) == 'V' )   cval = 'V' !'VV'
+          IF ( trim(cval) == 'TSK' ) cval = 'SKINTEMP'
+
+          !!! OK - we want this - lets continue
+          jvar = jvar + 1
+          jshape = 0
+          interpolate = .FALSE.
+          fix_meta_stag = .FALSE.
+          rcode = nf_redef(mcid)
+          DO ii = 1, idm
+            test_dim_name = dnamei(ishape(ii))
+            IF ( test_dim_name == 'bottom_top' .OR. test_dim_name == 'bottom_top_stag' ) THEN
+                 IF ( test_dim_name == 'bottom_top_stag' ) fix_meta_stag = .TRUE.
+                 test_dim_name = 'num_metgrid_levels'
+                 interpolate = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'west_east_stag' )   THEN
+               test_dim_name = 'west_east'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            IF ( unstagger_grid .AND. test_dim_name == 'south_north_stag' ) THEN
+               test_dim_name = 'south_north'
+               fix_meta_stag = .TRUE.
+            ENDIF
+            DO jj = 1,j
+              IF ( test_dim_name == dnamej(jj) ) THEN
+                jshape(ii) = jj
+              ENDIF
+            ENDDO
+
+            IF ( jshape(ii) == 0 ) THEN
+              j = j + 1
+              jshape(ii) = j
+              dnamej(j) = dnamei(ishape(ii))
+              dvalj(j) = dvali(ishape(ii))
+              rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+            ENDIF
+          ENDDO
+          rcode = nf_def_var(mcid, cval, itype, idm, jshape, jvar)
+
+          DO na = 1, natt
+             rcode = nf_inq_attname(ncid, ivar, na, cname)
+             IF ( fix_meta_stag .AND. trim(cname) == 'stagger' ) THEN
+                att_text = "-"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSEIF ( fix_meta_stag .AND. trim(cname) == 'coordinates' ) THEN
+                att_text = "XLONG XLAT"
+                ilen = len_trim(att_text)
+                rcode = nf_put_att_text(mcid, jvar, cname, ilen, att_text(1:ilen) )
+             ELSE
+                rcode = nf_copy_att(ncid, ivar, cname, mcid, jvar)
+             ENDIF
+          ENDDO
+
+          IF ( extrapolate == 0 ) THEN
+            rcode = nf_put_att_real(mcid, jvar, 'missing_value', NF_FLOAT, 1, MISSING )
+          ENDIF
+
+          rcode = nf_enddef(mcid)
+
+
+
+! GET THE DIMS FOR INPUT AND OUTPUT FROM THE SHAPE
+          dims_in  = 1
+          dims_out = 1
+          DO ii = 1,idm
+            dims_in(ii)  = dvali(ishape(ii))
+            dims_out(ii) = dvalj(jshape(ii))
+          ENDDO
+          IF (debug) THEN
+            write(6,*) 'VAR: ',trim(cval)
+            write(6,*) '     DIMS  IN: ',dims_in
+            write(6,*) '     DIMS OUT: ',dims_out
+          ENDIF
+  
+
+
+! ALLOCATE THE INPUT AND OUTPUT ARRAYS
+! READ THE DATA FROM INPUT FILE
+
+	  IF     (itype == 2) THEN          ! character
+            allocate (text(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+	    rcode = nf_get_var_text(ncid, ivar, text)
+	    rcode = nf_put_vara_text (mcid, jvar, start_dims, dims_in, text)
+            IF (debug) write(6,*) '     SAMPLE VALUE = ',text(:,1,1,1)
+            deallocate (text)
+  
+  
+	  ELSEIF (itype == 4) THEN          ! integer
+            allocate (idata1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+	    rcode = nf_get_var_int(ncid, ivar, idata1)
+	    rcode = nf_put_vara_int (mcid, jvar, start_dims, dims_in, idata1)
+            IF (debug) write(6,*) '     SAMPLE VALUE = ',idata1(dims_in(1)/2,dims_in(2)/2,1,1)
+            deallocate (idata1)
+  
+  
+	  ELSEIF (itype == 5) THEN          ! real
+            allocate (data1(dims_in(1), dims_in(2), dims_in(3), dims_in(4)))
+            allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+	    rcode = nf_get_var_real(ncid, ivar, data1)
+  
+            IF (idm >= 4 .AND. interpolate) THEN  
+               IF (debug) write(6,*) '     THIS IS A FIELD WE NEED TO INTERPOLATE'       
+
+               IF ( dims_in(1) == iweg .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagU, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(2) == isng .AND. .not. unstagger_grid ) THEN
+                  CALL interp (data2, data1, pres_stagV, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               ELSEIF ( dims_in(1) == iweg .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(2) == isng .AND. unstagger_grid ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 iweg-1, isng-1, ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSEIF ( dims_in(3) == ibtg ) THEN
+                  allocate (data3(iweg-1, isng-1, ibtg-1, dims_in(4)))
+                  data3(:,:,1:ibtg-1,:) = (data1(:,:,1:ibtg-1,:) + data1(:,:,2:ibtg,:)) * .5
+                  CALL interp (data2, data3, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), ibtg-1, dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+                  deallocate(data3)
+               ELSE
+                  CALL interp (data2, data1, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                                 dims_in(1), dims_in(2), dims_in(3), dims_in(4), &
+                                 num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+               END IF
+
+               IF (debug) write(6,*) '     SAMPLE VALUE IN  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+               IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+
+            ELSEIF (idm == 3 .AND. unstagger_grid ) THEN  
+               IF ( dims_in(1) == iweg ) THEN
+                  data2(1:iweg-1,:,:,:) = (data1(1:iweg-1,:,:,:) + data1(2:iweg,:,:,:)) * .5
+               ELSEIF ( dims_in(2) == isng ) THEN
+                  data2(:,1:isng-1,:,:) = (data1(:,1:isng-1,:,:) + data1(:,2:isng,:,:)) * .5
+               ELSE
+	         data2 = data1
+               ENDIF
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+	    ELSE
+	       data2 = data1
+               IF (debug) write(6,*) '     SAMPLE VALUE  = ',data1(dims_in(1)/2,dims_in(2)/2,1,1)
+
+	    ENDIF
+            
+	    rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+
+            deallocate (data1)
+            deallocate (data2)
+  
+  
+          ENDIF
+  
+        ENDDO loop_variables
+
+
+!!! We have some special variables we are interested in: PRES, TT, GHT
+        IF ( debug ) print*," "
+        IF ( debug ) print*,"Calculatng some diagnostics"
+           
+        jshape = 0
+        DO ii = 1, 4
+          IF ( ii == 1 ) test_dim_name = 'west_east'
+          IF ( ii == 2 ) test_dim_name = 'south_north'
+          IF ( ii == 3 ) test_dim_name = 'num_metgrid_levels'
+          IF ( ii == 4 ) test_dim_name = 'Time'
+          DO jj = 1,j
+            IF ( test_dim_name == dnamej(jj) ) THEN
+              jshape(ii) = jj
+            ENDIF
+          ENDDO
+
+          IF ( jshape(ii) == 0 ) THEN
+            j = j + 1
+            jshape(ii) = j
+            dnamej(j) = dnamei(ishape(ii))
+            dvalj(j) = dvali(ishape(ii))
+            rcode = nf_def_dim(mcid, dnamej(j), dvalj(j), j)
+          ENDIF
+        ENDDO
+        dims_in  = 1
+        dims_out = 1
+        DO ii = 1,4
+          dims_out(ii) = dvalj(jshape(ii))
+        ENDDO
+
+        interpolate = .TRUE.
+
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'PRES') /= 0 ) THEN
+           !!! PRES
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "PRES", 5, 4, jshape, "XZY", "Pressure           ", "Pa", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: PRES'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, pres_out)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',pres_out(dims_out(1)/2,dims_out(2)/2,1,1)
+        ENDIF
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'TT') /= 0 ) THEN
+           !!! TT
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "TT  ", 5, 4, jshape, "XZY", "Temperature        ", "K ", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: TT'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, tk, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'GHT') /= 0 ) THEN
+           !!! GHT
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "GHT ", 5, 4, jshape, "XZY", "Geopotential Height", "m ", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: GHT'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, ght, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .TRUE., MISSING)
+           data2 = data2/9.81
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+        IF ( INDEX(process,'all') /= 0 .OR. INDEX(process_these_fields,'RH') /= 0 ) THEN
+           !!! RH
+           jvar = jvar + 1
+           CALL def_var (mcid, jvar, "RH  ", 5, 4, jshape, "XZY", "Relative Humidity  ", "% ", "-", "XLONG XLAT")
+           IF (debug) THEN
+             write(6,*) 'VAR: RH'
+             write(6,*) '     DIMS OUT: ',dims_out
+           ENDIF
+           allocate (data2(dims_out(1),dims_out(2),dims_out(3),dims_out(4)))
+           CALL interp (data2, rh, pres_field, interp_levels, psfc, ter, tk, qv,   &
+                          iweg-1, isng-1, ibtg-1, dims_in(4), &          
+                          num_metgrid_levels, LINLOG, extrapolate, .FALSE., MISSING)
+           WHERE ( rh < 0.0 ) 
+              rh = 0.0
+           ENDWHERE
+           WHERE ( rh > 100.0 )
+              rh = 100.0
+           ENDWHERE
+           rcode = nf_put_vara_real (mcid, jvar, start_dims, dims_out, data2)
+           IF (debug) write(6,*) '     SAMPLE VALUE OUT = ',data2(dims_out(1)/2,dims_out(2)/2,1,1)
+           deallocate(data2)
+        ENDIF
+
+
+!!! Close files on exit
+        rcode = nf_close(ncid)
+        rcode = nf_close(mcid)
+        write(6,*) 
+      ENDDO 
+
+  
+      write(6,*) 
+      write(6,*) "##############################################################"
+      write(6,*) " SUCCESS: We are out of here"      
+      write(6,*) "##############################################################"
+
+ END PROGRAM p_interp
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+!---------------------------------------------------------------------
+ SUBROUTINE handle_err(rcode)
+    INTEGER rcode
+    write(6,*) 'Error number ',rcode
+    stop
+ END SUBROUTINE
+!---------------------------------------------------------------------
+ SUBROUTINE interp (data_out, data_in, pres_field, interp_levels, psfc, ter, tk, qv, ix, iy, iz, it, &
+                     num_metgrid_levels, LINLOG, extrapolate, GEOPT, MISSING)
+
+     INTEGER                                          :: ix, iy, iz, it
+     INTEGER                                          :: num_metgrid_levels, LINLOG
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: data_out
+     REAL, DIMENSION(ix, iy, iz, it)                  :: data_in, pres_field, tk, qv
+     REAL, DIMENSION(ix, iy, it)                      :: psfc
+     REAL, DIMENSION(ix, iy)                          :: ter
+     REAL, DIMENSION(num_metgrid_levels)              :: interp_levels
+
+     INTEGER                                          :: i, j, itt, k, kk, kin
+     REAL, DIMENSION(num_metgrid_levels)              :: data_out1D
+     REAL, DIMENSION(iz)                              :: data_in1D, pres_field1D
+     INTEGER                                          :: extrapolate
+     REAL                                             :: MISSING
+     REAL, DIMENSION(ix, iy, num_metgrid_levels, it)  :: N
+     REAL                                             :: sumA, sumN, AVE_geopt
+     LOGICAL                                          :: GEOPT
+
+     N = 1.0
+
+!!! MARS MARS MARS
+     !expon=287.04*.0065/9.81
+     expon=192.*.0045/3.72
+
+
+     do itt = 1, it
+        do j = 1, iy
+        do i = 1, ix
+           data_in1D(:)    = data_in(i,j,:,itt)
+           pres_field1D(:) = pres_field(i,j,:,itt)
+           CALL int1D (data_out1D, data_in1D, pres_field1D, interp_levels, iz, num_metgrid_levels, LINLOG, MISSING)
+           data_out(i,j,:,itt) = data_out1D(:)
+        end do
+        end do
+     end do
+
+
+     ! Fill in missing values
+     IF ( extrapolate == 0 ) RETURN       !! no extrapolation - we are out of here
+
+     ! First find where about 400 hPa is located
+     kk = 0
+     find_kk : do k = 1, num_metgrid_levels
+        kk = k
+        if ( interp_levels(k) <= 40000. ) exit find_kk
+     end do find_kk
+
+     
+     IF ( GEOPT ) THEN     !! geopt is treated different below ground
+
+        do itt = 1, it
+           do k = 1, kk
+              do j = 1, iy
+              do i = 1, ix
+                 IF ( data_out(i,j,k,itt) == MISSING .AND. interp_levels(k) < psfc(i,j,itt) ) THEN
+
+!                We are below the first model level, but above the ground 
+
+!!! MARS MARS
+                    data_out(i,j,k,itt) = ((interp_levels(k) - pres_field(i,j,1,itt))*ter(i,j)*3.72 +  &
+                                           (psfc(i,j,itt) - interp_levels(k))*data_in(i,j,1,itt) ) /   &
+                                          (psfc(i,j,itt) - pres_field(i,j,1,itt))
+
+                 ELSEIF ( data_out(i,j,k,itt) == MISSING ) THEN
+
+!                We are below both the ground and the lowest data level.
+
+!                First, find the model level that is closest to a "target" pressure
+!                level, where the "target" pressure is delta-p less that the local
+!                value of a horizontally smoothed surface pressure field.  We use
+!                delta-p = 150 hPa here. A standard lapse rate temperature profile
+!                passing through the temperature at this model level will be used
+!                to define the temperature profile below ground.  This is similar
+!                to the Benjamin and Miller (1990) method, except that for
+!                simplicity, they used 700 hPa everywhere for the "target" pressure.
+!                Code similar to what is implemented in RIP4
+
+
+!!! MARS MARS MARS
+                    ptarget = (psfc(i,j,itt)*.01) - 1.50 !150.
+                    dpmin=1.e2 !1.e4
+                    kupper = 0
+                    loop_kIN : do kin=iz,1,-1
+                       kupper = kin
+                       dp=abs( (pres_field(i,j,kin,itt)*.01) - ptarget )
+                       if (dp.gt.dpmin) exit loop_kIN
+                       dpmin=min(dpmin,dp)
+                    enddo loop_kIN
+
+                    pbot=max(pres_field(i,j,1,itt),psfc(i,j,itt))
+                    zbot=min(data_in(i,j,1,itt)/3.72,ter(i,j))   !!MARS MARS
+
+                    tbotextrap=tk(i,j,kupper,itt)*(pbot/pres_field(i,j,kupper,itt))**expon
+                    tvbotextrap=virtual(tbotextrap,qv(i,j,1,itt))
+
+                    data_out(i,j,k,itt) = (zbot+tvbotextrap/.0045*(1.-(interp_levels(k)/pbot)**expon))*3.72   !!MARS MARS
+               
+                 ENDIF
+              enddo
+              enddo
+           enddo
+        enddo
+
+
+        !!! Code for filling missing data with an average - we don't want to do this
+        !!do itt = 1, it
+           !!loop_levels : do k = 1, num_metgrid_levels
+              !!sumA = SUM(data_out(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!sumN = SUM(N(:,:,k,itt), MASK = data_out(:,:,k,itt) /= MISSING)
+              !!IF ( sumN == 0. ) CYCLE loop_levels
+              !!AVE_geopt = sumA/sumN
+              !!WHERE ( data_out(:,:,k,itt) == MISSING )
+                 !!data_out(:,:,k,itt) = AVE_geopt
+              !!END WHERE
+           !!end do loop_levels
+        !!end do
+
+     END IF
+     
+     !!! All other fields and geopt at higher levels come here
+     do itt = 1, it
+        do j = 1, iy
+        do i = 1, ix
+          do k = 1, kk
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,1,itt)
+          end do
+          do k = kk+1, num_metgrid_levels
+             if ( data_out(i,j,k,itt) == MISSING ) data_out(i,j,k,itt) = data_in(i,j,iz,itt)
+          end do
+        end do
+        end do
+     end do
+       
+
+ END SUBROUTINE interp 
+!------------------------------------------------------------------------------
+!--------------------------------------------------------
+ SUBROUTINE int1D(xxout, xxin, ppin, ppout, npin, npout, LINLOG, MISSING)
+
+! Modified from int2p - NCL code
+! routine to interpolate from one set of pressure levels
+! .   to another set  using linear or ln(p) interpolation
+!
+! NCL: xout = int2p (pin,xin,pout,linlog)
+! This code was originally written for a specific purpose.
+! .   Several features were added for incorporation into NCL's
+! .   function suite including linear extrapolation.
+!
+! nomenclature:
+!
+! .   ppin   - input pressure levels. The pin can be
+! .            be in ascending or descending order
+! .   xxin   - data at corresponding input pressure levels
+! .   npin   - number of input pressure levels >= 2
+! .   ppout  - output pressure levels (input by user)
+! .            same (ascending or descending) order as pin
+! .   xxout  - data at corresponding output pressure levels
+! .   npout  - number of output pressure levels
+! .   linlog - if abs(linlog)=1 use linear interp in pressure
+! .            if abs(linlog)=2 linear interp in ln(pressure)
+! .   missing- missing data code. 
+
+!                                                ! input types
+      INTEGER   :: npin,npout,linlog,ier
+      real      :: ppin(npin),xxin(npin),ppout(npout)
+      real      :: MISSING       
+     logical                                          :: AVERAGE
+!                                                ! output
+      real      :: xxout(npout)
+      INTEGER   :: j1,np,nl,nin,nlmax,nplvl
+      INTEGER   :: nlsave,np1,no1,n1,n2,nlstrt
+      real      :: slope,pa,pb,pc
+
+! automatic arrays
+      real      :: pin(npin),xin(npin),p(npin),x(npin)
+      real      :: pout(npout),xout(npout)
+
+
+      xxout = MISSING
+      pout  = ppout
+      p     = ppin
+      x     = xxin
+      nlmax = npin
+
+! exact p-level matches
+      nlstrt = 1
+      nlsave = 1
+      do np = 1,npout
+          xout(np) = MISSING
+          do nl = nlstrt,nlmax
+              if (pout(np).eq.p(nl)) then
+                  xout(np) = x(nl)
+                  nlsave = nl + 1
+                  go to 10
+              end if
+          end do
+   10     nlstrt = nlsave
+      end do
+
+      if (LINLOG.eq.1) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      slope = (x(nl)-x(nl+1))/ (p(nl)-p(nl+1))
+                      xout(np) = x(nl+1) + slope* (pout(np)-p(nl+1))
+                  end if
+              end do
+          end do
+      elseif (LINLOG.eq.2) then
+          do np = 1,npout
+              do nl = 1,nlmax - 1
+                  if (pout(np).lt.p(nl) .and. pout(np).gt.p(nl+1)) then
+                      pa = log(p(nl))
+                      pb = log(pout(np))
+! special case: in case someone inadvertently enter p=0.
+                      if (p(nl+1).gt.0.d0) then
+                          pc = log(p(nl+1))
+                      else
+                          pc = log(1.d-4)
+                      end if
+
+                      slope = (x(nl)-x(nl+1))/ (pa-pc)
+                      xout(np) = x(nl+1) + slope* (pb-pc)
+                  end if
+              end do
+          end do
+      end if
+
+
+! place results in the return array;
+      xxout = xout
+
+ END SUBROUTINE int1D
+
+!------------------------------------------------------------------------------
+ FUNCTION virtual (tmp,rmix)
+!      This function returns virtual temperature in K, given temperature
+!      in K and mixing ratio in kg/kg.
+
+     real                              :: tmp, rmix, virtual
+
+     virtual=tmp*(0.622+rmix)/(0.622*(1.+rmix))
+
+ END FUNCTION virtual
+
+!------------------------------------------------------------------------------
+ SUBROUTINE all_spaces ( command , length_of_char ) 
+
+      IMPLICIT NONE
+
+      INTEGER                                       :: length_of_char
+      CHARACTER (LEN=length_of_char)                :: command
+      INTEGER                                       :: loop
+
+      DO loop = 1 , length_of_char
+         command(loop:loop) = ' '
+      END DO
+
+ END SUBROUTINE all_spaces
+
+!------------------------------------------------------------------------------
+ SUBROUTINE def_var (mcid, jvar, cval, itype, idm, jshape, order, desc, units, stag, coord )
+
+      IMPLICIT NONE
+
+      INCLUDE 'netcdf.inc'
+
+      INTEGER              :: mcid, jvar
+      CHARACTER (LEN =  4) :: cval
+      INTEGER              :: itype, idm
+      REAL, DIMENSION(6)   :: jshape
+      CHARACTER (LEN =  3) :: order
+      CHARACTER (LEN = 19) :: desc
+      CHARACTER (LEN =  2) :: units
+      CHARACTER (LEN =  1) :: stag
+      CHARACTER (LEN = 10) :: coord
+
+      INTEGER            :: rcode, ilen
+      CHARACTER (LEN=30) :: att_text
+
+
+      IF ( itype == 5 ) THEN
+         rcode = nf_redef(mcid)
+         rcode = nf_def_var(mcid, trim(cval), NF_REAL, idm, jshape, jvar)
+         rcode = nf_put_att_int(mcid, jvar, "FieldType", NF_INT, 1, 104)
+      ENDIF
+
+      att_text = order
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "MemoryOrder", ilen, att_text(1:ilen) )
+
+      att_text = desc
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "description", ilen, att_text(1:ilen) )
+
+      att_text = units
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "units", ilen, att_text(1:ilen) )
+
+      att_text = stag
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "stagger", ilen, att_text(1:ilen) )
+
+      att_text = coord
+      ilen = len_trim(att_text)
+      rcode = nf_put_att_text(mcid, jvar, "coordinates", ilen, att_text(1:ilen) )
+
+      rcode = nf_enddef(mcid)
+
+ END SUBROUTINE def_var
+!------------------------------------------------------------------------------
+!------------------------------------------------------------------------------
Index: /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/w2g.f
===================================================================
--- /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/w2g.f	(revision 19)
+++ /trunk/mesoscale/LMD_MM_MARS/SRC/POSTPROC/w2g.f	(revision 19)
@@ -0,0 +1,1031 @@
+!=================================
+!! Aymeric Spiga - 10/2009
+!! NB: this is a slightly modified version of WRFnc2ctl.f called w2g
+!! NB: it is able to read Martian files
+!=================================
+
+
+!! This program read a WRF netcdf file and create the necessary .ctl 
+!! files to display WRF netcdf directly with GrADS.
+!!
+!! Note, due to staggering, you get 4 .ctl files, one for mass points, one
+!! for U points, one for V points and one for W points. 
+!! They need to be open all at once in GrADS.
+!!
+!! When using this method to display WRF in GrADS, one cannot inpertolate 
+!! to pressure/height levels, and no extra diagnostics are available
+!
+!=================================Make Executable============================
+!  Make executable:
+!    DEC Alpha
+!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o WRFnc2ctl
+!
+!   linux flags
+!      pgf90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -Mfree  -o WRFnc2ctl
+!
+!   Sun flags
+!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -free  -o WRFnc2ctl
+!
+!   SGI flags
+!      f90 WRFnc2ctl.f -L/usr/local/netcdf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -freeform  -o WRFnc2ctl
+!
+!   IBM flags
+!      xlf WRFnc2ctl.f -L/usr/local/lib32/r4i4 -lnetcdf -lm  \
+!      -I/usr/local/netcdf/include  -qfree=f90  -o WRFnc2ctl
+!
+!   Mac flags (with xlf compiler)
+!      xlf WRFnc2ctl.f -L/usr/local/netcdf-xlf/lib -lnetcdf -lm  \
+!      -I/usr/local/netcdf-xlf/include  -qfree=f90  -o WRFnc2ctl
+!
+!   If you extra compile flags for other computers - please send along
+!
+!=================================Run Program================================
+!  Run program:
+!
+!          WRFnc2ctl   -i wrf_netcdf_input_file   -o ctl_output_name
+!
+!=================================Options====================================
+!
+! -help     : Print help information                           
+! -h        : Print help information                           
+! -i        : WRF input file (netcdf format)                   
+! -o        : ctl output name                                  
+! -debug    : Print some debug information
+!
+!============================================================================
+!
+!  December 2006
+!  Cindy Bruyere
+!
+     program WRFnc2ctl
+
+     implicit none
+     include 'netcdf.inc'
+
+  character (len=200)                                 :: input_file                  ! netcdf input file
+  logical                                             :: have_vert_stag=.FALSE.      ! also need W.ctl file
+  integer                                             :: cdfid                       ! input file unit number
+  real                                                :: rcode                       ! return status code for netcdf
+  integer                                             :: ndims, nvars, natts         ! number of dims, var and att in file
+  integer                                             :: unlimdimid                  ! unlimited dims ID - not used
+
+  character (len=80)                                  :: case                        ! ctl file name
+  character (len=80)                                  :: ctl_U, ctl_V, ctl_W, ctl_M  ! ctl file name
+  character (len=200), allocatable, dimension(:)      :: M_vars                      ! variables to ctl
+  character (len=200),              dimension(10)     :: U_vars, V_vars, W_vars      ! variables to ctl
+  integer                                             :: i_M, i_U, i_V, i_W          ! number of t/u/v/w variables
+  character (len=200)                                 :: var_string                  ! tmp var string
+  character (len=40)                                  :: tdef                        ! ctl tdef
+  integer                                             :: ntimes                      ! number of times in input file
+  integer                                             :: end_ctl_files               ! sometimes we will have 3, sometimes 4 .ctl files
+
+  character (len=31), allocatable, dimension(:)       :: dnam                        ! name of netcdf DIMS
+  integer,            allocatable, dimension(:)       :: dval                        ! value of netcdf DIMS
+  character (len=40)                                  :: title                       ! global att from netcdf file
+  character (len=1)                                   :: gridtype                    ! global att from netcdf file
+  real                                                :: cen_lon, cen_lat            ! global att from netcdf file
+  real                                                :: stand_lon                   ! global att from netcdf file
+  real                                                :: truelat1, truelat2          ! global att from netcdf file
+  real                                                :: dx, dy                      ! global att from netcdf file
+  integer                                             :: map_proj                    ! global att from netcdf file
+
+  character (len=80)                                  :: varnam                      ! var from netcdf file
+  integer                                             :: idvar                       ! varnam id number     
+  integer                                             :: ivtype                      ! varnam type          
+  integer                                             :: idm                         ! varnam - number of dims
+  integer                                             :: natt                        ! varnam attributes
+  character (len=80)                                  :: description                 ! varnam description
+  character (len=80)                                  :: units                       ! varnam units
+  character (len=80)                                  :: varnam_small                ! lowecase of varnam - for ctl file
+  character (len=80)                                  :: varout                      ! varnam + varnam_small - for ctl file
+
+  integer                                             :: len_unt, len_title          ! length of character strings  
+  integer                                             :: len_string, len_des         ! length of character strings  
+  integer                                             :: len_var                     ! length of character strings  
+
+  integer                                             :: dims(4), ishape(10)         ! netcdf array dims and shapes
+  character,          allocatable, dimension(:,:,:,:) :: times                       ! Times array from netcdf file
+  real,               allocatable, dimension(:,:,:,:) :: znu, znw                    ! arrays from netcdf file
+  real,               allocatable, dimension(:,:,:,:) :: xlat_M, xlon_M              ! u-staggered lat/lon     
+  real,               allocatable, dimension(:,:,:,:) :: xlat_U, xlon_U              ! u-staggered lat/lon     
+  real,               allocatable, dimension(:,:,:,:) :: xlat_V, xlon_V              ! v-staggered lat/lon     
+  real,                            dimension(4)       :: xlat_a, xlon_a              ! lat/lon corners
+  real                                                :: lat_ll_u, lat_ll_v          ! lat/lon corners
+  real                                                :: lat_ur_u, lat_ur_v          ! lat/lon corners
+  real                                                :: lon_ll_u, lon_ll_v          ! lat/lon corners
+  real                                                :: lon_ur_u, lon_ur_v          ! lat/lon corners
+  integer                                             :: iweg, isng, ibtg            ! staggered dims in input_file
+  real,                            dimension(16)      :: lats16, lons16              ! lat/lon corners
+ 
+  real                                                :: xi, xj                      ! PS defs
+  real                                                :: r, re                       ! PS defs
+  real                                                :: ref_lat, ref_lon            ! PS defs
+  real                                                :: rlat, rlong                 ! PS defs
+  real                                                :: earthr, radpd               ! PS defs
+  real                                                :: dx_ps                       ! PS defs
+  integer                                             :: ipole                       ! PS defs
+
+  integer                                             :: ilon                        ! flag indicating dateline in domain
+  real                                                :: abslatmin, abslatmax        ! min/max lat - for Lambert def's
+  real                                                :: abslonmin, abslonmax        ! min/max lon - for Lambert def's
+  integer                                             :: ipoints, jpoints            ! points used for Lambert def's     
+  real                                                :: dxll, slack                 ! Lambert area setup (xdef/ydef)    
+
+  integer                                             :: itmp, i, k                  ! tmp values                   
+  real                                                :: temp                        ! tmp values                   
+  real,               allocatable, dimension(:,:,:,:) :: tmp_var                     ! tmp values            
+
+  logical                                             :: mercator_defs               ! for better mercator projections
+  logical                                             :: debug                       ! for debug
+
+  integer                                             :: test1, test2  !!ajout
+
+
+   write(*,*) "  "
+   write(*,*) "================================================ "
+   write(*,*) "WRFnc2ctl for ARW WRF files      "
+   write(*,*) " Only works correctly for gradsnc from GrADS 1.9 "
+
+  tdef = '1 linear 00z01jan2000  1hr'
+
+! GET INPUT FILE AND OUTPUT CASE NAME FOR COMMAND LINE
+  if (debug) write(*,*) "READ arguments from command line"
+  call read_args(input_file,case,mercator_defs,debug)
+
+
+!! OPEN THE INPUT FILE
+   if (debug) write(*,*) "OPENING netcdf input file"           
+   rcode = nf_open (input_file, NF_NOWRITE, cdfid)
+   call handle_err ("Opening input netCDF file", rcode)
+   rcode = nf_get_att_text(cdfid, nf_global, 'GRIDTYPE', gridtype)
+   if ( trim(gridtype) .ne. 'C' ) then
+      write(*,*) 'Can only deal with ARW data for now'
+      STOP
+   endif
+
+
+!! GET BASIC INFORMATION ABOUT THE FILE
+   if (debug) write(*,*) "READ global attributes from netcdf file"
+   stand_lon = -99999.99   !!! backward compatibility
+   rcode = nf_get_att_text(cdfid, nf_global, 'TITLE',     title)
+   rcode = nf_get_att_real(cdfid, nf_global, 'DX',        dx)
+   rcode = nf_get_att_real(cdfid, nf_global, 'DY',        dy)
+   rcode = nf_get_att_real(cdfid, nf_global, 'CEN_LAT',   cen_lat)
+   rcode = nf_get_att_real(cdfid, nf_global, 'CEN_LON',   cen_lon)
+   rcode = nf_get_att_real(cdfid, nf_global, 'STAND_LON', stand_lon)
+   rcode = nf_get_att_real(cdfid, nf_global, 'TRUELAT1',  truelat1)
+   rcode = nf_get_att_real(cdfid, nf_global, 'TRUELAT2',  truelat2)
+   rcode = nf_get_att_int (cdfid, nf_global, 'MAP_PROJ',  map_proj)
+   rcode = nf_get_att_int (cdfid, nf_global, 'WEST-EAST_GRID_DIMENSION',  test1)    !!ajout
+   rcode = nf_get_att_int (cdfid, nf_global, 'SOUTH-NORTH_GRID_DIMENSION',  test2)  !!ajout 
+   if (stand_lon == -99999.99 ) stand_lon = cen_lat    !!! dealing with an old WRF file
+
+   if (debug) write(*,*) "READ dims from netcdf file"
+   rcode = nf_inq(cdfid, nDims, nVars, nAtts, unlimDimID)
+
+   print *, 'BEWARE if 64 bits NETCDF...'
+   print *, cdfid, nDims, nVars, nAtts, unlimDimID
+
+
+   allocate (M_vars(nVars))
+   allocate (dval(nDims))
+   allocate (dnam(nDims))
+   iweg = 1  
+   isng = 1  
+   ibtg = 1  
+   do i = 1,nDims
+     rcode = nf_inq_dim(cdfid, i, dnam(i), dval(i))
+     if ( dnam(i)(1:9)  == 'west_east'          ) iweg = max(iweg,dval(i))
+     if ( dnam(i)(1:11) == 'south_north'        ) isng = max(isng,dval(i))
+
+     if ( dnam(i)(1:10) == 'bottom_top'         ) ibtg = max(ibtg,dval(i))
+     if ( trim(dnam(i)) == 'num_metgrid_levels' ) ibtg = max(ibtg,dval(i))
+     if ( dnam(i)(1:4)  == 'land'               ) ibtg = max(ibtg,dval(i))
+     if ( dnam(i)(1:4)  == 'soil'               ) ibtg = max(ibtg,dval(i))
+     if ( dnam(i)(1:5)  == 'month'              ) ibtg = max(ibtg,dval(i))
+     if ( dnam(i)(1:5)  == 'z-dim'              ) ibtg = max(ibtg,dval(i))
+
+     if ( dnam(i)(1:15) == 'bottom_top_stag'    ) have_vert_stag = .TRUE.   
+   enddo
+
+!! OPEN THE OUTPUT FILES
+   write(*,*) 
+   write(*,*) "CREATING .ctl files for you case: ", case
+   write(*,*) 
+!   ctl_M = trim(case)//"_M.ctl"
+   ctl_M = trim(case)//".ctl"
+   ctl_U = trim(case)//"_U.ctl"
+   ctl_V = trim(case)//"_V.ctl"
+   ctl_W = trim(case)//"_W.ctl"
+   open (10, file=ctl_M)
+!   open (11, file=ctl_U)
+!   open (12, file=ctl_V)
+   if (have_vert_stag) open (13, file=ctl_W)
+
+!!-------------------------------------------------
+!! AS: ici fix pour les fichiers sortie de api qui sont deja de-stagg
+!horizontalement
+if (iweg .ne. test1) then
+    iweg=iweg+1
+    test1=-1
+    PRINT *, 'IF YOU HAVE A BOXED FILE w STAGG VARIABLES it is a PROBLEM'
+endif
+if (isng .ne. test2) then
+    isng=isng+1
+    test2=-1
+endif
+if (test1 .ne. -1) open (11, file=ctl_U) 
+if (test2 .ne. -1) open (12, file=ctl_V) 
+!!-------------------------------------------------
+
+  lat_ll_u = -999.99
+  lat_ll_v = -999.99
+  lat_ur_u = -999.99
+  lat_ur_v = -999.99
+  lon_ll_u = -999.99
+  lon_ll_v = -999.99
+  lon_ur_u = -999.99
+  lon_ur_v = -999.99
+
+!===========================================================================================
+
+      i_U = 0
+      i_V = 0
+      i_W = 0
+      i_M = 0
+
+      DO idvar = 1,nVars        !! LOOP THROUGH ALL VARIABLES IN FILE
+        rcode = nf_inq_var(cdfid, idvar, varnam, ivtype, idm, ishape, natt)
+        call handle_err ("ERROR reading variable", rcode)
+        if (debug) write(*,*) 
+        if (debug) write(*,*) "Variable:",idvar,"out of",nVars
+        if (debug) write(*,*) "DEALING with variable: ", trim(varnam)
+        if (.not. debug ) write(*,'("   Variable ",i2," :  ",A10,$)') idvar,varnam
+        if (.not. debug .and. idm .gt. 2 ) write(*,*) " (*)"
+        if (.not. debug .and. idm .le. 2 ) write(*,*) "    "
+
+!! GET THE DIMS FOR INPUT AND OUTPUT FROM THE SHAPE
+        dims  = 1
+        do i = 1,idm
+          dims(i)  = dval(ishape(i))
+        enddo
+        if (debug) write(*,*) " DIMS: ", dims
+
+
+!! GET THE UNITS AND DESCRIPTION OF THE FIELD
+        units = "                                                                                "
+        description = "                                                                                "
+        rcode = NF_GET_ATT_TEXT(cdfid, idvar, "units", units )
+        rcode = NF_GET_ATT_TEXT(cdfid, idvar, "description", description )
+        len_var = len_trim(varnam)
+        len_des = len_trim(description)
+        len_unt = len_trim(units)
+        if (debug) write(*,*) " DESCRIPTION: ", description(1:len_des)
+        if (debug) write(*,*) " UNITS: ", units(1:len_unt)
+
+!! GET THE LOWER CASE OF EACH varnam
+        varnam_small = " " 
+        do i = 1,len_var
+          if (varnam(i:i) .ge. 'A' .and. varnam(i:i) .le. 'Z') then
+            itmp = ichar(varnam(i:i)) + 32
+            varnam_small(i:i) = achar(itmp)
+          else
+            varnam_small(i:i) = varnam(i:i)
+          endif
+        enddo
+        write(varout,*) varnam(1:len_var)//"=>"//varnam_small(1:len_var)
+        len_var = max(22,len_trim(varout))
+
+!! BUILD THE CTL var LIST
+        IF     ( idm == 4 ) THEN
+          write(var_string,'(A,i4,"  t,z,y,x  ",A,"  (",A,")")') varout(1:len_var), dims(3), &
+description(1:len_des), units(1:len_unt)
+        ELSEIF ( idm == 3 ) THEN
+          write(var_string,'(A,i4,"  t,y,x    ",A,"  (",A,")")') varout(1:len_var), 0, &
+description(1:len_des), units(1:len_unt)
+        ENDIF
+        IF     ( idm .gt. 2 ) THEN
+          len_string = len_trim(var_string)
+          if     ( dims(1) == iweg ) then
+               i_U = i_U + 1
+               U_vars(i_U) = var_string(1:len_string)
+          elseif ( dims(2) == isng ) then
+               i_V = i_V + 1
+               V_vars(i_V) = var_string(1:len_string)
+          elseif ( dims(3) == ibtg .and. have_vert_stag) then
+               i_W = i_W + 1
+               W_vars(i_W) = var_string(1:len_string)
+          else
+               i_M = i_M + 1
+               M_vars(i_M) = var_string(1:len_string)
+          endif
+          if (debug) write(*,*) " CTL: ",var_string(1:len_string)
+        ENDIF
+
+
+!!!!
+!!!! WE NEED KEEP SOME EXTRA INFO BEFORE READING THE NEXT VARIABLE
+!!!!
+
+
+!! GET THE NUMBER OF TIMES IN FILE AND BUILD tdef
+        IF (varnam == 'Times' ) THEN
+           allocate (times(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_text(cdfid, idvar, times)
+           ntimes = dims(2)
+           call time_calc( times, ntimes, tdef, debug )
+        ENDIF
+
+!! GET VERTICAL INFORMATION FOR zdef, AND xlon/xlat FOR pdef
+        IF (varnam == 'ZNU' ) THEN
+           allocate (znu(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, znu)
+        ENDIF
+        IF (varnam == 'ZNW' ) THEN
+           allocate (znw(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, znw)
+        ENDIF
+        IF (varnam == 'XLAT'  ) THEN
+           allocate (xlat_M(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlat_M)
+        ENDIF
+        IF (varnam == 'XLAT_M'  ) THEN
+           allocate (xlat_M(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlat_M)
+        ENDIF
+        IF (varnam == 'XLAT_U'  ) THEN
+           allocate (xlat_U(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlat_U)
+        ENDIF
+        IF (varnam == 'XLAT_V'  ) THEN
+           allocate (xlat_V(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlat_V)
+        ENDIF
+        IF (varnam == 'XLONG' ) THEN
+           allocate (xlon_M(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlon_M)
+        ENDIF
+        IF (varnam == 'XLONG_M' ) THEN
+           allocate (xlon_M(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlon_M)
+        ENDIF
+        IF (varnam == 'XLONG_U'  ) THEN
+           allocate (xlon_U(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlon_U)
+        ENDIF
+        IF (varnam == 'XLONG_V' ) THEN
+           allocate (xlon_V(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, xlon_V)
+        ENDIF
+
+!! GET SOME CORNER INFORMATION
+        IF (varnam == 'LAT_LL_U' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lat_ll_u = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LAT_UR_U' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lat_ur_u = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LAT_LL_V' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lat_ll_v = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LAT_UR_V' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lat_ur_v = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+
+        IF (varnam == 'LON_LL_U' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lon_ll_u = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LON_UR_U' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lon_ur_u = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LON_LL_V' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lon_ll_v = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+        IF (varnam == 'LON_UR_V' ) THEN
+           allocate (tmp_var(dims(1), dims(2), dims(3), dims(4)))
+           rcode = nf_get_var_real(cdfid, idvar, tmp_var)
+           lon_ur_v = tmp_var(1,1,1,1)
+           deallocate (tmp_var)
+        ENDIF
+
+
+     
+      ENDDO       !! END OF VAR LOOP
+      write(*,*) " "
+      write(*,*) "      (*) = variables that will be available in CTL files"
+      write(*,*) " "
+      write(*,*) "DONE reading variables"
+      if (debug) write(*,*) " "
+!===========================================================================================
+ 
+!! CREATE THE CTL FILES
+
+    
+   if (debug) write(*,*) "START writing to .ctl files"
+   len_title = len_trim(title)
+   end_ctl_files = 12
+   if (have_vert_stag) end_ctl_files = 13
+   do i = 10,end_ctl_files
+      write(i,'("dset ^",A)') trim(input_file)
+      write(i,'("dtype netcdf")') 
+      write(i, '("undef 1.e37")')
+      write(i,'("title ",A)') title(1:len_title)
+   enddo
+   
+   IF (map_proj == 1) THEN                                     !! Lambert Projection
+     if (debug) write(*,*) "We have Lambert Projection data"
+      !PDEF for M
+      write(10,'("pdef ",i4," ",i3," lcc ",f7.3," ",f8.3," ",     &
+&          f8.3," ",f8.3," ",f9.5," ",f9.5," ",f10.5," ",         &
+&          f10.3," ",f10.3)')                                     &
+           iweg-1,isng-1,cen_lat,cen_lon,iweg/2.,isng/2.,         &
+           truelat1,truelat2,stand_lon,dx,dy
+      !PDEF for U
+      if (test1 .ne. -1) write(11,'("pdef ",i4," ",i3," lcc ",f7.3," ",f8.3," ",     &
+&          f8.3," ",f8.3," ",f9.5," ",f9.5," ",f10.5," ",         &
+&          f10.3," ",f10.3)')                                     &
+           iweg,isng-1,cen_lat,cen_lon,(iweg+1.)/2.,isng/2.,      &
+           truelat1,truelat2,stand_lon,dx,dy
+      !PDEF for V
+      if (test2 .ne. -1) write(12,'("pdef ",i4," ",i3," lcc ",f7.3," ",f8.3," ",     &
+&          f8.3," ",f8.3," ",f9.5," ",f9.5," ",f10.5," ",         &
+&          f10.3," ",f10.3)')                                     &
+           iweg-1,isng,cen_lat,cen_lon,iweg/2.,(isng+1.)/2.,      &
+           truelat1,truelat2,stand_lon,dx,dy
+      if (have_vert_stag) then
+       !PDEF for W 
+       write(13,'("pdef ",i4," ",i3," lcc ",f7.3," ",f8.3," ",    &
+&           f8.3," ",f8.3," ",f9.5," ",f9.5," ",f10.5," ",        &
+&           f10.3," ",f10.3)')                                    &
+            iweg-1,isng-1,cen_lat,cen_lon,iweg/2.,isng/2.,        &
+            truelat1,truelat2,stand_lon,dx,dy
+      endif
+
+      !make sure truelat1 is the larger number
+       if (truelat1 < truelat2) then
+          temp = truelat1
+          truelat1 = truelat2
+          truelat2 = temp
+       endif
+
+       xlon_a(1) = xlon_M(1,1,1,1)
+       xlon_a(2) = xlon_M(1,isng-1,1,1)
+       xlon_a(3) = xlon_M(iweg-1,1,1,1)
+       xlon_a(4) = xlon_M(iweg-1,isng-1,1,1)
+
+       !check for dateline
+       ilon = 0
+       if ( abs(xlon_a(1) - xlon_a(3)) .GT. 180. ) ilon = 1
+       if ( abs(xlon_a(2) - xlon_a(4)) .GT. 180. ) ilon = 1
+
+       abslatmin = minval(xlat_M)
+       abslatmax = maxval(xlat_M)
+       abslonmin =  99999.
+       abslonmax = -99999.
+
+       do i=1,4
+         IF ( xlon_a(i) .lt. 0.0 .AND. ilon .eq. 1 ) THEN
+           abslonmin=min(abslonmin,360.+xlon_a(i))
+           abslonmax=max(abslonmax,360.+xlon_a(i))
+         ELSE
+           abslonmin=min(abslonmin,xlon_a(i))
+           abslonmax=max(abslonmax,xlon_a(i))
+         ENDIF
+       enddo
+
+       dxll = (dx/1000.)/59./2.  !!MARS MARS MARS
+       slack = ((dx/1000.)*3.)/100.
+       ipoints = int(((abslonmax-abslonmin)+(3.*slack))/dxll)
+       jpoints = int(((abslatmax-abslatmin)+(3.*slack))/dxll)
+
+       do i = 10,end_ctl_files
+         write(i,'("xdef ",i4," linear ",f10.5," ",f12.8)') ipoints, &
+                     (abslonmin-1.5*slack),dxll
+         write(i,'("ydef ",i4," linear ",f10.5," ",f12.8)') jpoints, &
+                     (abslatmin-1.5*slack),dxll
+       enddo
+   ENDIF   
+
+   IF (map_proj == 2) THEN                                     !! Polar Stereo Projection
+     if (debug) write(*,*) "We have Polar Stereo Projection data"
+
+       ipole = 1
+       if (truelat1 .lt. 0.0) ipole = -1
+       radpd  = .01745329
+       !earthr = 6.3712E6
+       earthr = 3.3972E6       
+ 
+       dx_ps = dx/( (1.0+sin(ipole*TRUELAT1*radpd))/(1.0+sin(60*radpd)) ) !! true dx (meter) at 60degrees
+       re    = ( earthr * (1.0 + sin(60*radpd)) ) / dx_ps          !!
+
+
+       IF ( ipole == 1 ) THEN
+
+         rlong  = (xlon_M(1,1,1,1) - stand_lon) * radpd
+         rlat   = xlat_M(1,1,1,1) * radpd
+         r    =  (re * cos(rlat)) / (1.0 + sin(rlat))
+         xi   =  (1. - r * sin(rlong))
+         xj   =  (1. + r * cos(rlong))
+
+         !PDEF for M
+         write(10,'("pdef ",i3," ",i3," nps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg-1, isng-1,                &
+               xi, xj, stand_lon, dx_ps*0.001
+         !PDEF for U
+         if (test1 .ne. -1) write(11,'("pdef ",i3," ",i3," nps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg, isng-1,                  &
+               xi, xj, stand_lon, dx_ps*0.001
+         !PDEF for V
+         if (test2 .ne. -1) write(12,'("pdef ",i3," ",i3," nps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg-1, isng,                  &
+               xi, xj, stand_lon, dx_ps*0.001
+         if (have_vert_stag) then
+           !PDEF for W
+           write(13,'("pdef ",i3," ",i3," nps ",f8.3," ",f8.3," ", &
+&                f12.4," ",f12.7)') iweg-1, isng-1,                &
+                 xi, xj, stand_lon, dx_ps*0.001
+         endif  
+
+       ELSE IF ( ipole == -1 ) THEN
+
+         rlong  = (180.0 + xlon_M(1,1,1,1) - stand_lon) * radpd
+         rlat   = ipole*xlat_M(1,1,1,1) * radpd
+         r    =  (re * cos(rlat)) / (1.0 + sin(rlat))
+         xi   =  (1. - ipole * r * sin(rlong))
+         xj   =  (1. + r * cos(rlong))
+
+         !PDEF for M
+         write(10,'("pdef ",i3," ",i3," sps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg-1, isng-1,                &
+               xi, xj, (180+stand_lon), -0.001*dx_ps
+         !PDEF for U
+         if (test1 .ne. -1) write(11,'("pdef ",i3," ",i3," sps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg, isng-1,                  &
+               xi, xj, (180+stand_lon), -0.001*dx_ps
+         !PDEF for V
+         if (test2 .ne. -1) write(12,'("pdef ",i3," ",i3," sps ",f8.3," ",f8.3," ", &
+&              f12.4," ",f12.7)') iweg-1, isng,                  &
+               xi, xj, (180+stand_lon), -0.001*dx_ps
+         if (have_vert_stag) then
+         !PDEF for W
+           write(13,'("pdef ",i3," ",i3," sps ",f8.3," ",f8.3," ", &
+&                f12.4," ",f12.7)') iweg-1, isng-1,                &
+                 xi, xj, (180+stand_lon), -0.001*dx_ps
+         endif
+ 
+       END IF
+
+
+       abslonmin = minval(xlon_M)
+       abslonmax = maxval(xlon_M)
+       abslatmin = minval(xlat_M)
+       abslatmax = maxval(xlat_M)
+
+       dxll = (dx_ps/1000.)/59./2.   !! MARS MARS
+       ipoints = int(((abslonmax-abslonmin)+2.)/dxll)-2
+       jpoints = int(((abslatmax-abslatmin)+2.)/dxll)-3
+
+       ref_lon = abslonmin-1.
+       IF ( abslonmax .ge. 175. .AND. abslonmax .le. 180.) THEN
+         IF ( abslonmin .ge. -180. .AND. abslonmin .le. -175.) THEN
+           ref_lon = 0.0
+         END IF
+       END IF
+
+       ref_lat = abslatmin-1.
+       IF ( ipole == -1 ) ref_lat = abslatmin
+
+
+       do i = 10,end_ctl_files
+         write(i,'("xdef ",i4," linear ",f6.1," ",f12.8)') ipoints, &
+                     ref_lon,dxll
+         write(i,'("ydef ",i4," linear ",f6.1," ",f12.8)') jpoints, &
+                     ref_lat,dxll
+       enddo
+
+   ENDIF   
+
+   IF (map_proj == 3) THEN                                     !! Mercator Projection
+       if (debug) write(*,*) "We have Mercator Projection data"
+
+       !check to see if we have the corner lat/lon
+       if ( allocated(xlat_U) ) then
+         lat_ll_u = xlat_U(1,1,1,1)
+         lat_ur_u = xlat_U(iweg,isng-1,1,1)
+       endif
+       if ( allocated(xlat_V) ) then
+         lat_ll_v = xlat_V(1,1,1,1)
+         lat_ur_v = xlat_V(iweg-1,isng,1,1)
+       endif
+       if ( allocated(xlon_U) ) then
+         lon_ll_u = xlon_U(1,1,1,1)
+         lon_ur_u = xlon_U(iweg,isng-1,1,1)
+       endif
+       if ( allocated(xlon_V) ) then
+         lon_ll_v = xlon_V(1,1,1,1)
+         lon_ur_v = xlon_V(iweg-1,isng,1,1)
+       endif
+
+       if ( lat_ll_u==-999.99 .or. lat_ur_u==-999.99 .or. lat_ll_v==-999.99 .or. lat_ur_v==-999.99 .or. &
+            lon_ll_u==-999.99 .or. lon_ur_u==-999.99 .or. lon_ll_v==-999.99 .or. lon_ur_v==-999.99 ) then ! try getting them from the global att
+          if (debug) write(*,*) ' NO STAGGERED LAT/LON DATA AVAILBLE - try and get it from meta data '
+          rcode = nf_get_att_real(cdfid, nf_global, 'corner_lons', lons16)
+          if ( rcode == 0 ) then     
+            rcode = nf_get_att_real(cdfid, nf_global, 'corner_lats', lats16)
+            lat_ll_u = lats16( 5)
+            lat_ur_u = lats16( 7)
+            lat_ll_v = lats16( 9)
+            lat_ur_v = lats16(11) 
+            lon_ll_u = lons16( 5)
+            lon_ur_u = lons16( 7)
+            lon_ll_v = lons16( 9)
+            lon_ur_v = lons16(11)
+          else
+             write(*,*) ' NO STAGGERED LAT/LON DATA AVAILBLE - FAKE IT'
+            lat_ll_u = xlat_M(1,1,1,1)           - abs(xlat_M(2,1,1,1)-xlat_M(1,1,1,1))/2.0
+            lat_ur_u = xlat_M(iweg-1,isng-1,1,1) + abs(xlat_M(2,1,1,1)-xlat_M(1,1,1,1))/2.0
+            lat_ll_v = xlat_M(1,1,1,1)           - abs(xlat_M(1,2,1,1)-xlat_M(1,1,1,1))/2.0
+            lat_ur_v = xlat_M(iweg-1,isng-1,1,1) + abs(xlat_M(1,2,1,1)-xlat_M(1,1,1,1))/2.0
+            lon_ll_u = xlon_M(1,1,1,1)           - abs(xlon_M(2,1,1,1)-xlon_M(1,1,1,1))/2.0
+            lon_ur_u = xlon_M(iweg-1,isng-1,1,1) + abs(xlon_M(2,1,1,1)-xlon_M(1,1,1,1))/2.0
+            lon_ll_v = xlon_M(1,1,1,1)           - abs(xlon_M(1,2,1,1)-xlon_M(1,1,1,1))/2.0
+            lon_ur_v = xlon_M(iweg-1,isng-1,1,1) + abs(xlon_M(1,2,1,1)-xlon_M(1,1,1,1))/2.0
+          endif
+       endif
+
+       !check for dateline
+       ilon = 0
+       if ( abs(xlon_M(1,1,1,1)      - xlon_M(iweg-1,1,1,1))      .GT. 180. ) ilon = 1
+       if ( abs(xlon_M(1,isng-1,1,1) - xlon_M(iweg-1,isng-1,1,1)) .GT. 180. ) ilon = 1
+
+       IF ( ilon == 1 ) THEN
+
+         !! For M
+         WRITE(10,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+            iweg-1,xlon_M(1,1,1,1), &
+            (abs(xlon_M(1,1,1,1)-(360.+xlon_M(iweg-1,isng-1,1,1)))/(iweg-2))
+         !! For U
+         if (test1 .ne. -1) WRITE(11,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+            iweg,lon_ll_u, &
+            (abs(lon_ll_u-(360.+lon_ur_u))/(iweg-1))
+         !! For V
+         if (test2 .ne. -1) WRITE(12,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+            iweg-1,lon_ll_v, &
+            (abs(lon_ll_v-(360.+lon_ur_v))/(iweg-2))
+         if (have_vert_stag) then
+           !! For W
+           WRITE(13,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+              iweg-1,xlon_M(1,1,1,1), &
+              (abs(xlon_M(1,1,1,1)-(360.+xlon_M(iweg-1,isng-1,1,1)))/(iweg-2))
+         endif
+
+       ELSE
+
+         IF ( mercator_defs .AND. allocated(xlon_U) .AND. allocated(xlon_V) ) THEN
+           WRITE(10,'("xdef ",i4," levels ")') iweg-1  !! M
+           if (test1 .ne. -1) WRITE(11,'("xdef ",i4," levels ")') iweg    !! U
+           if (test2 .ne. -1) WRITE(12,'("xdef ",i4," levels ")') iweg-1  !! V
+           if (have_vert_stag) WRITE(13,'("xdef ",i4," levels ")') iweg-1  !! W
+           DO i = 1,iweg-1
+              WRITE(10,*) xlon_M(i,1,1,1)
+           END DO
+           DO i = 1,iweg
+              if (test1 .ne. -1) WRITE(11,*) xlon_U(i,1,1,1)
+           END DO
+           DO i = 1,iweg-1
+              if (test2 .ne. -1) WRITE(12,*) xlon_V(i,1,1,1)
+           END DO
+           if (have_vert_stag) then
+             DO i = 1,iweg-1
+                WRITE(13,*) xlon_M(i,1,1,1)
+             END DO
+           endif  
+         ELSE
+           !! For M
+           WRITE(10,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+              iweg-1,xlon_M(1,1,1,1), &
+              (abs(xlon_M(1,1,1,1)-(xlon_M(iweg-1,isng-1,1,1)))/(iweg-2))
+           !! For U
+           if (test1 .ne. -1) WRITE(11,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+              iweg,lon_ll_u, &
+              (abs(lon_ll_u-(lon_ur_u))/(iweg-1))
+           !! For V
+           if (test2 .ne. -1) WRITE(12,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+              iweg-1,lon_ll_v, &
+              (abs(lon_ll_v-(lon_ur_v))/(iweg-2))
+           if (have_vert_stag) then
+             !! For W
+             WRITE(13,'("xdef ",i4," linear ",f9.4," ",f8.4)')   &
+                iweg-1,xlon_M(1,1,1,1), &
+                (abs(xlon_M(1,1,1,1)-(xlon_M(iweg-1,isng-1,1,1)))/(iweg-2))
+           endif
+         END IF
+
+       ENDIF
+
+       IF ( mercator_defs .AND. allocated(xlat_U) .AND. allocated(xlat_V) ) THEN
+          WRITE(10,'("ydef ",i4," levels ")') isng-1  !! M
+          if (test1 .ne. -1) WRITE(11,'("ydef ",i4," levels ")') isng-1  !! U
+          if (test2 .ne. -1) WRITE(12,'("ydef ",i4," levels ")') isng    !! V
+          if (have_vert_stag) WRITE(13,'("ydef ",i4," levels ")') isng-1  !! W
+          DO i = 1,isng-1
+            WRITE(10,*) xlat_M(1,i,1,1)
+          END DO
+          DO i = 1,isng-1
+            if (test1 .ne. -1) WRITE(11,*) xlat_U(1,i,1,1)
+          END DO
+          DO i = 1,isng
+            if (test2 .ne. -1) WRITE(12,*) xlat_V(1,i,1,1)
+          END DO
+          if (have_vert_stag) then
+            DO i = 1,isng-1
+              WRITE(13,*) xlat_M(1,i,1,1)
+            END DO
+          endif  
+       ELSE
+          !! For M
+          WRITE(10,'("ydef ",i4," linear ",f9.4," ",f8.4)')   &
+                    isng-1,xlat_M(1,1,1,1),(abs(xlat_M(1,1,1,1)-xlat_M(iweg-1,isng-1,1,1))/(isng-2))
+          !! For U
+          if (test1 .ne. -1) WRITE(11,'("ydef ",i4," linear ",f9.4," ",f8.4)')   &
+                    isng-1,lat_ll_u,(abs(lat_ll_u-lat_ur_u)/(isng-2))
+          !! For V
+          if (test2 .ne. -1) WRITE(12,'("ydef ",i4," linear ",f9.4," ",f8.4)')   &
+                    isng-1,lat_ll_v,(abs(lat_ll_v-lat_ur_v)/(isng-2))
+          if (have_vert_stag) then
+            !! For W
+            WRITE(13,'("ydef ",i4," linear ",f9.4," ",f8.4)')   &
+                      isng-1,xlat_M(1,1,1,1),(abs(xlat_M(1,1,1,1)-xlat_M(iweg-1,isng-1,1,1))/(isng-2))
+          endif
+       ENDIF
+
+   ENDIF
+
+
+
+   if (have_vert_stag) then
+     !FOR M
+       write(10,'("zdef  ",i3, " levels  ")') ibtg-1
+       do k = 1,ibtg-1
+          write(10,'(f10.5)') znu(k,1,1,1)
+       enddo
+     !FOR U
+       if (test1 .ne. -1) write(11,'("zdef  ",i3, " levels  ")') ibtg-1
+       do k = 1,ibtg-1
+          if (test1 .ne. -1) write(11,'(f10.5)') znu(k,1,1,1)
+       enddo
+     !FOR V
+       if (test2 .ne. -1) write(12,'("zdef  ",i3, " levels  ")') ibtg-1
+       do k = 1,ibtg-1
+          if (test2 .ne. -1) write(12,'(f10.5)') znu(k,1,1,1)
+       enddo
+     !FOR W
+       write(13,'("zdef  ",i3, " levels  ")') ibtg
+       do k = 1,ibtg
+          write(13,'(f10.5)') znw(k,1,1,1)
+       enddo
+   else
+     do i = 10,end_ctl_files
+       write(i,'("zdef  ",i3," linear 1 1")') ibtg
+     enddo
+   endif
+
+
+   !TDEF
+   do i = 10,end_ctl_files
+     write(i,'("tdef  ",A)') tdef
+   enddo
+
+
+   if (debug) write(*,*) "WRITING variables to .ctl files" 
+   !VARS
+   write(10,'("vars  ",i3)') i_M
+   do i = 1,i_M
+      write(10,'(A)') trim(M_vars(i))
+   enddo
+   if (test1 .ne. -1) write(11,'("vars  ",i3)') i_U
+   do i = 1,i_U
+      if (test1 .ne. -1) write(11,'(A)') trim(U_vars(i))
+   enddo
+   if (test2 .ne. -1) write(12,'("vars  ",i3)') i_V
+   do i = 1,i_V
+      if (test2 .ne. -1) write(12,'(A)') trim(V_vars(i))
+   enddo
+   if (have_vert_stag) then
+     write(13,'("vars  ",i3)') i_W
+     do i = 1,i_W
+        write(13,'(A)') trim(W_vars(i))
+     enddo
+   endif
+
+
+   do i = 10,end_ctl_files
+      write(i,'("endvars")') 
+   enddo
+   CALL SYSTEM ( '( rm -rf fort.11 fort.12 )' )
+
+!===========================================================================================
+
+  rcode = nf_close(cdfid)  
+
+  write(*,*) "Successful "
+  write(*,*) "================================================ "
+  print*,"  "
+
+  end program WRFnc2ctl
+!------------------------------------------------------------------------------
+
+  subroutine time_calc( times, ntimes, tdef, debug )
+
+  character (len=19)             :: times(ntimes), time
+  character (len=3)              :: mth, t_ind
+  character (len=40)             :: tdef
+  integer                        :: year,month,day,hh1,hh2,mn1,mn2,seconds,hourint,minsint,tdiff
+  integer                        :: ntimes
+  logical                        :: debug
+
+
+!! Time comes in as YYYY-MM-DD_HH:MM:SS
+!!                  1234 67 90 23 45 89
+   time = times(1)
+   read(time(1:4),*)   year
+   read(time(6:7),*)   month
+   read(time(9:10),*)  day
+   read(time(12:13),*) hh1
+   read(time(15:16),*) mn1
+
+    if (month == 0) return      
+    if (month == 1) mth = 'jan'
+    if (month == 2) mth = 'feb'
+    if (month == 3) mth = 'mar'
+    if (month == 4) mth = 'apr'
+    if (month == 5) mth = 'may'
+    if (month == 6) mth = 'jun'
+    if (month == 7) mth = 'jul'
+    if (month == 8) mth = 'aug'
+    if (month == 9) mth = 'sep'
+    if (month ==10) mth = 'oct'
+    if (month ==11) mth = 'nov'
+    if (month ==12) mth = 'dec'
+
+   !if (debug) 
+     write(*,*) "Start date is: ",year,"-",month,"-",day,"_",hh1,":",mn1
+
+   if (ntimes .ge. 2) then
+     time = times(2)
+     read(time(12:13),*) hh2
+     read(time(15:16),*) mn2
+     hourint = abs(hh2-hh1)
+     minsint = abs(mn2-mn1)
+     if (hourint == 0 ) then
+       tdiff = minsint                  
+       t_ind = 'mn'                       
+     else
+       tdiff = hourint                 
+       t_ind = 'hr'                       
+     endif
+   else
+     tdiff = 1                 
+     t_ind = 'hr'                       
+   endif
+
+    tdef = '                               '
+   
+    !!!! TEMPORARY STUFF
+    !'00z01jan2000  1hr'
+    !hh1 = 00
+    !day = 01
+    !mth = 'jan'
+    !year = 2000
+    !tdiff = 1
+    !t_ind = 'hr'    
+    !!!! TEMPORARY STUFF
+
+    write (tdef,'(i4," linear ",i2,"z",i2,A,i4,"  ",i3,A)') ntimes, hh1, day, mth, year, tdiff, t_ind
+    !write (tdef,'(i4," linear ",A,"Z",A,A,i4,"  ",i3,A)') ntimes, time(12:13), time(9:10), mth, year, tdiff, t_ind
+    !! PB de +1 dans la date
+
+    !write (tdef,'(i4, " linear 00Z01jan2000  1hr")') ntimes 
+    !if (debug) 
+    write(*,*) "TDEF is set to: ",tdef
+
+  end subroutine time_calc
+
+!------------------------------------------------------------------------------
+
+  subroutine help_info
+
+  print*," "
+  print*," WRFnc2ctl   -i wrf_netcdf_input_file   -o ctl_output_name"
+  print*," "
+  print*," Current options available are:"
+  print*," -help     : Print this information"                           
+  print*," -h        : Print this information"                           
+  print*," -i        : WRF input file (netcdf format)"                  
+  print*," -o        : ctl output name - default is ARWout"                                 
+  print*," -mercator : Use if mercator projection is stretched"         
+  print*," -debug    : Print some debug information"                    
+
+  STOP
+
+  end subroutine help_info
+
+!------------------------------------------------------------------------------
+  subroutine read_args(input_file,case,mercator_defs,debug) 
+
+  implicit none
+  character (len=200)   :: input_file                        
+  character (len=80)    :: case                        
+  logical               :: mercator_defs, debug
+
+  integer, external     :: iargc
+  integer               :: numarg, i
+  character (len=80)    :: dummy
+
+
+! set up some defaults first
+  input_file = " "
+  case       = "ARWout"
+  numarg     = iargc()
+  i          = 1
+  mercator_defs = .FALSE.
+  debug = .FALSE.
+
+
+  if (numarg == 0) call help_info
+
+  do while (i <= numarg)
+    call getarg(i,dummy)
+
+    if (dummy(1:1) == "-") then    ! We have an option, else it is the filename
+
+      SELECTCASE (trim(dummy))
+          CASE ("-help")
+               call help_info
+          CASE ("-h")
+               call help_info
+          CASE ("-i")
+               i = i+1
+               call getarg(i,dummy)         ! read input_file name
+               input_file = dummy
+          CASE ("-o")
+               i = i+1
+               call getarg(i,dummy)         ! read case name
+               case = dummy
+          CASE ("-mercator")
+               mercator_defs = .TRUE.
+          CASE ("-debug")
+               debug = .TRUE.
+          CASE DEFAULT
+               call help_info
+      END SELECT
+    else
+      input_file = dummy                     ! if option -i was not used for input file
+    endif
+
+      i = i+1
+
+  enddo
+
+  if (input_file == " ") call help_info
+
+
+  end subroutine read_args
+
+!------------------------------------------------------------------------------
+      subroutine handle_err(message,nf_status)
+      include "netcdf.inc"
+      integer                 :: nf_status
+      character (len=80)      :: message
+      if (nf_status .ne. nf_noerr) then
+         write(*,*)  'ERROR: ', trim(message)
+         STOP 
+      endif
+      end subroutine handle_err
+!------------------------------------------------------------------------------
+
