gradsScriptCreation.f

      ********************************************************************************
      * This file collects functions for the creation of visualisation scripts
      * in grads script.
      * TODO: to be extended
   5: *******************************************************************************
      
            SUBROUTINE openSimpleGS (p_fileId, p_fileName,p_bgName,p_varName)
      ************************************************************************
      * Opens a normal grads script file with grads logo and axes turned off and the
  10: * passed in self-describing netcdf file as background.
      *
      * Input:
      *  - p_fileId (Integer): the unit number of the file
      *  - p_fileName (String): the name of the new file (the grads script file extension
  15: *	".gs" is automatically appended to the name!)
      *  - p_bgName (String): a self-describing NetCDF file for the background (full file name)
      *  - p_varName (String): the name of the variable in the NetCDF file to be displayed
      ************************************************************************
       
  20: *     Functions from the function library
            INTEGER strlen
      
      *     Parameters
            INTEGER p_fileId
  25:       CHARACTER*(*) p_fileName, p_bgName, p_varName
      
      *     Vars
            CHARACTER fileName*100, bgName*100, varName*20
            fileName = p_fileName
  30:       bgName = p_bgName
            varName=p_varName
      
      *     Open grads script file to be written
            OPEN(p_fileId,
  35:      c file=fileName(1:strlen(fileName)) // ".gs" )
      
            WRITE (p_fileId, *) "say 'Autogenerated GradsScript File'"
            WRITE (p_fileId, *) "say 'Opening the background'"
            WRITE (p_fileId, *) "'sdfopen " // bgName(1:strlen(bgName)) // "'"
  40: *     Shaded background style
            WRITE (p_fileId, *) "'set gxout shaded'"
            WRITE (p_fileId, *) "'c'"
            WRITE (p_fileId, *) "'set xlab off'"
            WRITE (p_fileId, *) "'set ylab off'"
  45:       WRITE (p_fileId, *) "'set grads off'"
            if (strlen(varName) > 0)
           c    WRITE (p_fileId, *) "'d ", varName(1:strlen(varName)) , "'"
                  
            END
  50: 
         
            SUBROUTINE drawGSPt (p_fileId, p_lat, p_lon, p_size, 
           c      p_style, p_label)   
      ************************************************************************
  55: * Writes the code into the grads script file for drawing a marker point 
      * on the NetCDF background.
      *  
      * Input:
      *  - p_fileId (Integer): the unit number of the grads script file
  60: *  - p_lat (Real): the latitude of the point to be drawn
      *  - p_lon (Real): the longitude of the point to be drawn
      *  - p_size (Real): the size of the point (for coordinate locations 0.1 is
      *	 normally small, 0.3 medium, 0.5 big)
      *  - p_style (Integer): which style the marker should have, available:
  65: *       1 = cross,
      *       2 = open circle
      *       3 = closed circle
      *       4 = open square
      *       5 = closed square
  70: *       6 = X
      *       7 = diamond
      *       8 = triangle
      *       9 = none
      *      10 = open circle with vertical line
  75: *      11 = open oval
      *  - p_label (String): if anything but "" is passed in, this label is written
      *	 next to the marker point
      ************************************************************************
      
  80:       INTEGER p_fileId, p_style, strlen
            REAL p_lat, p_lon, p_size !params
            CHARACTER p_label*(*), label*50
            label = p_label
            
  85:        WRITE (p_fileId, *) ""
             WRITE (p_fileId, *) "'q ll2xy", p_lon, p_lat, "'"
             WRITE (p_fileId, *) "xco = subwrd(result,1)"
             WRITE (p_fileId, *) "yco = subwrd(result,2)"
             WRITE (p_fileId, *) "'draw mark ",p_style,
  90:      c                     " ' xco ' ' yco '", p_size, "'"
             if (strlen(label) > 0) 
           c  WRITE (p_fileId, *) "'draw string ' xco+0.2 ' ' yco-0.1 ' " // 
           c     label(1:strlen(label)) // "'"
            
  95:       END
            
      
            SUBROUTINE closeSimpleGS (p_fileId, p_fileName)
      ************************************************************************
 100: * Finishes (i.e. writes command for GrADS meta file output) and closes 
      * the open grads script file.
      *
      * Input:
      *  - p_fileId (Integer): the unit number of the file
 105: *  - p_fileName (String): the name of the script output file (the grads metafile 
      * 	extension ".gds" is automatically appended to the name!)
      ************************************************************************
      
            
 110: *     Functions from the function library
            INTEGER strlen
      
      *     Parameters
            INTEGER p_fileId
 115:       CHARACTER p_fileName*(*)
      
      *     Vars
            CHARACTER fileName*100
            fileName = p_fileName
 120:       fileName = fileName(1:strlen(fileName)) // '.gds'
            
            WRITE (p_fileId, *) "'enable print ",
           c      fileName(1:strlen(fileName)),"'"
            WRITE (p_fileId, *) "'print'"
 125:       WRITE (p_fileId, *) "'disable print'"
            WRITE (p_fileId, *) "'quit'"
            
            CLOSE(p_fileId)
            END


Info Section
Warning: externals (function calls) may not be acurate
back to top
f2html v0.3 (C) 1997,98 Beroud Jean-Marc. Fri Aug 11 17:54:58 CEST 2006